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| ence 8he FiiSeicg Pansat tdesaze viele o8e.1 _ 
MODULE BASSVIRTUAL ARR ( ' virtual Array interfe 
BASVIRTUA.B32 Edit: DG1033 


IDENT = = '1-033' ' File: 6 


BEGIN 


LRA REAR RRERERERRAER EAE EREERAEE EAE RAAT A AAA EA AE AAA AAARAARAAHER EERE EEE 


feature. Therefore, change OTS$ to BAS$ tn the entry 

nein ts: me only longwords thy be passed as indexes. 

i 1-005 = Since virtual array descriptors will have their indicies 
computed in the same way as ordinary arrays, rearrange 

the code to compute the location in the array of the value 


; 1 0001 

; ¢ Ba08 

; 000 

; 4 0004 1 

; 5 Bop? 1 

3 6 Boe 1 

3 7 0007 1 !* * 
; 8 0008 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * 
3 9 0009 1 !* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * 
; 19 id } :* ALL RIGHTS RESERVED. * 
4 if 2 
; ig porg 1 !'® THIS SOFTWARE as FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * 
; 1 0015 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * 
; 14 0014 1 !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFT T * 
3 15 0015 1 !* COPIES THEREOF wid NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 
; 16 0016 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
3 i id EA ! :* TRANSFERRED. * 
4 '® *® 
3 19 0019 1 !* He. INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 
; 2 0020 1 !* AD SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
; $3 bos) : 7 CORPORATION. + 
3 '® * 
.) ae 0038 1 !'s DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * 
; 626 0024 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * 
ore 0025 1 !* * 
; @& 0026 1 !* * 
3 a7 0027 7 PITITITITILTILILI LILLE LLL LLL LITT iii tiiitiitiiitiite 
; a 0028 1! 

ZS ae 0029 1 

; 39 sit i i PACILITY VAX-11 BASIC Vi LA S 

; : © irtua rray Support 

3 32 0032 1! 

; 33 0033 1 ! ABSTRACT: 

3 34 0034 1! 

5 $2 0035 1! This module contains the support for VAX-11 BASIC virtual 

3 6 0036 1! arrays. This consists of the various FETCH and STORE routines 

3 3 ait 44 ’ called by compiled code and the interface to the I/0 system. 

3 39 0039 1 ! ENVIRONMENT: VAX-11 User Mode 

; 60 0040 1! 

3 0041 1 ! AUTHOR: John Sauter, CREATION DATE: 02-FEB-1979 

3s 2 94 1 7 

3; «645 0043 1 ! MODIFIED BY: 

s 0044 1! 

3; 6) 0045 1! 1-001 - tt ee This version handles only non-virtual arrays. 

; 46 0046 1! -1979 

ae 0047 1 ! 1-002 - Make the 186 1398" points take arguments in registers. 

; 48 0048 1! JBS 26-FE 

: «#649 0049 1 ! 1-003 - Take lehege definitions from BASVIRTUA.REQ. JBS a 

$ 50 0050 1 ! 1-004 - Based on a review of the virtual array sence t with pers 

3 2) 00 ' } of the VAX ECO board, virtual arrays are ASIC-on 

r} 2§ 3 

: 54 1! 

$ 55 1! 

; %  % 

: 57 4 
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1-035 127868713 4 9588346 BASRTL. RCJBASVIRTUA.B 2;1 . (1) 
3 8 058 1! before ¢cnecking the class of the descriptor. This als 
3 9 $36 1! helps support Srrays of dynamic strin Me JBS 03-APR-1979 
; 60 060 1 ! 1-006 = Add calls to internal vartuot array gu routines. These are 
>; «61 bes 1! just stubs for now. JBS 04-APR-197 
3; § 8 $¢ 1 ! 1-007 = Call temporary 1/0 routine $8 we can check out the indexing 
; 6 Cf 065 1! subroutines. JBS 04-APR-19 
; 64 0064 1 ! 1-008 - Make those temporary 1/0 routines permanent, and handle 
; 0065 1! trailin WU s greverty when fetching and storing strings. 
>; 3666 8008 1! JBS 18-MAY-197 
; of 067 1 ! 1-009 = Change OTS$S to STR$ gg 39 F JBS 18-MAY-1979 
: 68 0068 1 ! 1-010 = Change STRSCOPY_R_DX to STRSCOPY_R JBS 20-MAY-1979 
; @& B08? 1! 1-011 - corcegs a type hich caused normal array fetches to fail. 
; 0070 1! JBS 31-MAY-197 
Ba 0071 1 ! 1-012 = Correct the local definition of DSCSK_DTYPE_DSC. We must 
; ££ bors 1; remember to remove this when the definition goes into 
aG@e 00735 1! RILSTARLE. JBS 01-JUN-1979 
; 0074 1 ! 1-013 - Make the index parameters to GASSFETCH_VA and BASS$STORE_VA 
a taR a 0075 1! be by value. JBS 01-JUN-197 
; £6 0076 1 ! 1-914 = Correct an error in storing a orc toe. JBS_05-JUN-1979 
“Me i 4 0077 1 ! 1-015 = Debug string virtual arrays. JBS 11-JUN-1979 
s £3 0078 1 ! 1-016 = Remove local definitions of DSC$ symbols. JBS 19-JUN-1979 
; 0079 1 ! 1-017 = Use BASLNK. JBS 26-JUN-1979 ; 
: 80 0080 1 ! 1-018 = Add BASSSTO_FA_RDX. JBS 13-JUL-1979 
o 0081 1 ! 1-019 = Change calls to STRSCOPY. JBS 19-JUL-1979 
; 82 0082 1 ! 1-020 - Change BASSSCOPY_D and BASSSCOPY_F to end in _R1. JBS 23-AUG-1979 
3; 683 0083 1 ! 1-021 - Allow the INDEX2 argument of BASSSTO_FA_RDX to be zero. 
; 84 0084 1! J -NOV-197 J ‘ 
; 85 0085 1 ! 1-022 - Speed up storing into a ity virtual aceey by creating the 
; 0086 1! nulls with a single call to STRSDUPL_CHAR instead of with 
3 87 0087 1. multiple calls to STRSCONCAT. JBS 19-MAY-1980 
; 8 0088 1 ! 1-023 = Add support for byte, g and h floating. PLL 9-Sep-81 
3 0089 1 ! 1-024 - Add Support for records. Otype Z indicates a record - 
; 90 0090 1: it is handled the same as text. PLL 26-Feb-82 — 
3; 91 0091 1 ! {-925 = Fix bug from edit 024 - Deype Z required extending the range 
3; Ve 0092 1! of CASE statements. PLL 5-Mar-82 
; 0093 1 ! 1-026 = Add support for decimal arrays. Decimal lengths are the number 
; % 0094 1! of digits (not fs ladtng the sign) rather than the number of bytes, 
; 0095 1! so the calculation of the Linear index is slightly different. 
; 0096 1! PLL 12-Mar- 
s oF 0097 1 ! 1-027 - Remove a couple of dots from the ASHP instruction. PLL 12-Apr-82 
; 0098 1 ! 1-028 - The last edit corrected FETCH_BFA = also correct STORE_BFA. 
; WF 0099 1! 12-Apr-82 
; 100 0100 1! 1-08) - Change call to VA_FETCH, VA_STORE for decimal arrays. PLL 12-Apr-82 
; 101 0101 1 ! 1-030 - Add entry point BAS$STORE_BFA OFF. PLL 8-Jun-1982 
3: 102 BI 1 ! 1-031 - Modify BASSSTORE_BFA_OFF So that no checking is performed on 
3; 103 0103 1! the source and destination data types. PLL 26-Jul-1982 
3; 104 0104 1 ! 1-032 - modified all length calculations that used to round up to the 
: 105 0105 1! nearest multple of 2 to round up to the nearest POWER of 2. 
: 106 0106 1! added a kludge to dummy up the length of a record in the array 
; 107 0107 1! descr just prior to the call to BASSVA_STORE in BASSSTORE_BFA_OFF. 
3; 108 3198 1! MDL 3-Aug-1 
3 109 109 1 ! 1-033 = Add support for dynamically mapped arrays. DG 6-Feb-1984 
3; 110 0110 1! NOTE = these changes did not have to Se tacorperated into the 
3; 99) 0111 1! BASS$STO_FA... routines because the routine that calls the STORE 
: Ng git¢ 1! routines specifically calls BASSSTORE_BFA for dynamically mapped 
i Me Oia 1 i ot 
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wets - 132308- 138 94:88:26 BASRTL  SREIBASVIRIUA.692: 1 . (2) 
; 118 17 1! 
s 319 118 1 ! SWITCHES: 
@peeen Bb 
: 1 § 121 1 SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
: 1S 0198 1 
> 125 o1 4 1 | LINKAGES: 
: 189 O58 1 
: 128 0157 1 LINKAGE 
; tev 1 4 1 COPY _JSB = = ay ty Ney = 0, img yg #1)! 
: 4 é 0131 1 REQUIRE "RTLIN:BASLNK’; ! Define Linkage VA_JSB 
| 0909 1 
; 135 0210 1 { TABLE OF CONTENTS: 
: 13 O512 1. 
; 138 051% 1 FORWARD ROUTINE 
; 139 0214 1 BASSFETCH_BFA : NOVALUE, ! Fetch a value by descriptor 
3; 140 0215 1 BASSSTORE_BFA : NOVALUE, ! Store a value by descriptor 
3 141 0216 1 BASSSTORE_BFA_OFF : NOVALUE, ! Store value by desc w/offset 
3 be 0217 1 BASSSTO_FA_RDR : NOVALUE, ' Store a string by reference 
: 14 0218 1 BASSFET_FA_W_R8 : VA_JSB, i Fetch a word 
; 144 0219 1 BASS$STO_FA_W_R8 : VA_JSB NOVALUE, ' Store a word 
3: «145 0220 1 BASSFET_FA_L_R8 : VA_JSB, ! Fetch a longword 
: 146 0221 1 BAS$STO_FA_L_R8 : VA_JSB NOVALUE, ' Store a longword 
: 147 pees 1 BASSFET_FA_F_R8 : VA_JSB, ! Fetch a floating value 
: 148 0223 1 BASSSTO_FA_F_R8 : VA_JSB NOVALUE, ! Store a floating value 
3: (149 0224 1 BAS er eT FAD Re : VA_JSB NOVALUE, ' Fetch a double-floating value 
3; 190 0225 1 BASS$STO_FA_D_R8 : VA_JSB NOVALUE, ! Store a double-floating value 
: 151 0226 1 BASSFET-FA_B_R8 : VA_JSB, i Fetch a byte 
; 138 0227 1 BAS$STO“FA_B_RS VA_JSB NOVALUE, i Store a byte 
3 0228 1 BASSFET_FA_G_R VA_JSB NOVALUE, ! Fetch a g floating value 
3; 156 0229 1 BASS$STO_FA_G_R8 : VA_JSB NOVALUE, ! Store a g floating value 
: 155 0230 1 BASSFET_FA_H_R8 : VA_JSB NOVALUE, ! Fetch an h floating value 
: 156 0231 1 BASSSTO_FA_H_R8 : VA_JSB NOVALUE; ! Store an h floating value 
: 188 0933 | | 
: 159 0234 1 | INCLUDE FILES: 
i Re 
; 162 0937 i REQUIRE 'RTLIN:RTLPSECT'; ! Macros for defining psects 
> 164 $333 1 LIBRARY ‘RTLSTARLE'; ' System symbols 
: 186 O333 1 | 
: 167 033% 1 | MACROS: 
; 168 03 ,! 
: 1% 1, Bt gsiecnene 
; 4 Ne i EQUATED SYMBOLS: 
: 17 348 1} NONE 
3; «174 0345 1! 
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i835 1e-8ep-19 4 or 6:46 BASRTL. RCIBASVIRTUA. $2:1 ns (2) 1 
s 175 44 1 ! PSECTS: i 
H 128 > 3 7 ; 
: ive 8 ‘3 : DECLARE _PSECTS (BAS); ! Declare psects for BAS$ facility : 
: 179 0 rt 1 ! OWN STORAGE: i 
; 180 0349 1! i 
; #181 0350 1! NONE : 
: 186 8 + ae ‘ 
; 26 1 ! EXTERNAL REFERENCES: ‘ 
; «(184 03535 1! i 
> «(185 0354 1 i 
; 6186 8 2? 1 thie ROUTINE i 
; «187 $ 1 BASSS$STOP : NOVALUE ! signals fatal error ‘ 
; 188 03 1 BASSSCOPY_F_R1 : COPY_JSB NOVALUE, i Copy a floating number 
3; «(189 0358 1 BASSSCOPY_D_R1 : COPY_JSB NOVALUE, ! Copy a double number | 
; 190 0359 1 BASSSCOPY_G_R1 : COPY_JSB NOVALUE, ! Copy a g float number 
s 191 0360 1 BASSSCOPY_H_R3 : COPY _JSB NOVALUE, ! Copy an h float number | 
: 198 0361 1 BASSSVA_FETCH : NOVALOE, ' Fetch from virt. array i 
3; #19 8306 1 BASSSVA_STORE : NOVALUE, ! Store in virt. array | 
3 194 0365 1 TRSGETT_DX, ' Allocate a otring ; 
3; 195 0364 1 STRSFREET DX, ' Deallocate a string i 
> 196 0365 1 SCOPY_Bx, ' Copy by descriptor 
3 197 0366 1 STRSCOPY_R, ! Copy by reference | : 
3; «198 0367 1 STRSCONCAT, ' Concatenate two strings 
3; 19 0368 1 STRSDUPL_CHAR; ! Make lots of a character : 
; 200 0369 1 i 
; 201 0370 1 !+ F 
3 $06 0371 1 ! The following are the error codes used in this module. : 
; 20 0372 1 !- { 
3; 204 0373 (1 i 
; 205 0374 1 EXTERNAL LITERAL ; : 
; 206 0375 1 BASS$K_MATARRTOO : UNSIGNED (8), ! Matrix or array too large 4 
; 207 0376 1 BASSK_VIRARROPE : UNSIGNED (8), | 
; 208 0377 1 BASSK_VIRARRDIS : UNSIGNED (8), | 
; 209 0378 #1 ™ UTRAN : UNSIGNED (8), | 
; 210 0379 1 BASSK_FATSYSIO. : UNSIGNED (8), i 
; 211 0380 1 BASSK_DATTYPERR : UNSIGNED (8), | 
: sig 0381 1 BASSK_ EWARG : UNSIGNED (8), ; 
; 1 Oees 1 am ARG : UNSIGNED (8), H 
3; 214 0383 1 “ARGDONMAT : UNSIGNED (8), i 
s 215 0384 1 BASSK_FLOPOIERR : UNSIGNED (8), , 
: $18 0385 1 ASSK_RECBUCLOC : UNSIGNED (8), i 
; 17 0386 1 BASSK_ONEOR_TWO : UNSIGNED (8), ; 
3 $i8 3344 : BASSK_NOTIMP : UNSIGNED (8); i 
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: 1 4 1 GLOBAL ROUTINE BASSFETCH_BFA ( Fetch a value by descriptor 
; ¢ 1 DESCRIP : REF BLOCK (8, BYTE), The descriptor 
; 91 1 VALUE : REF BLOCK (8, 6YTE], i where to put it 
: 4 3 1 INDEX1 ! First index 
; 5 9 1 ) : NOVALUE = 
; 6 94 «1 
3 7 95 1 S44 
; . ? ' : FUNCTIONAL DESCRIPTION: 
3 0 98 1! Fetch a value from an array or virtual ervey The location in 
3 1 Fa+4 } which to place the value is passed by descriptor. 
H : etd : FORMAL PARAMETERS: 
; 5 0405 1! DESCRIP.rx.da The descriptor of the array or virtual array 
; 0404 1! VALUE . wx ..dx The place to put the value fetched ee 
3 gor 0405 1! INDEX1.rl.v The first index into the es More indicies 
; en pene 7% may follow this one in the calling sequence. 
>; 239 0407 1! 
; sro 0408 1 ! IMPLICIT INPUTS: 
: 241 0409 1! 
3 seg 0410 1! NONE 
: 4 0411 1! 
; sie Berg 1 ! IMPLICIT OUTPUTS: 
3: 245 041 7s 
13 $48 0414 1! NONE 
3 47 0415 1! 
; 248 0416 1 ! ROUTINE VALUE: 
: 249 0417 1 ! COMPLETION CODES: 
; a 0418 1! 
ee +). 0419 1! NONE 
3 $26 0420 1! 
3; 0421 1 ! SIDE EFFECTS: 
: 2546 bess 1! 
 @20 04 1! Signals if an error is encountered. 
; 256 0424 1! 
s; @or 0425 1 !<- 
; 258 0426 1 
3 $28 0427 2 BEGIN 
; 260 0428 § 
: 261 0429 UILTIN 
3 $06 0430 2 ACTUALCOUNT 
3; 26 0431 ACTUALPARAMETER, 
3 64 04 § SHP; 
; 265 04 
; 266 0434 LOCAL 
: 267 0435 INDEX_VALUE 
; 368 045 VALUE ~LOCATION 
> 269 43 MULTIPLIERS : REF VECTOR, 
: 270 438 OUNDS : REF VECTOR, 
3; 271 439 OW _iNDEX 
3 i 0440 HIGR_INDEX, 
EP - 0441 INDER_INC 
3: 276 044 INDEX_NUMBER, 
3: 275 044 VALUE_DESCR : BLOCK (12, BYTE], 
3; 276 0444 VALUE _DESC_ADDR, 
: e277 0445 LENGTR; 
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! (not including the sign). Convert this to the number of bytes. 
' Decimal virtual arrays and record virtual arrays are stored with 
: a length that is a multiple of 2 - check for that here also. 


seen” | panama COSCSB_DTYPE] FROM DSCSK_DTYPE_Z TO DSCSK_DTYPE_H OF 


; 278 44 

3; ey bc? + 

; 280 448 : Be sure the number of array subscripts matches the number of 

; 28) 0449 ! indicies given to us. 

oR Rg 

; 284 126 IF ((ACTUALCOUNT () = 2) NEQU .DESCRIP COSCSB_DIMCTI) 

3 ¢ee 945 THEN 

; 286 0454 BEGIN 

; 287 0455 

3 4 3628 4 IF (C(ACTUALCOUNT () = 2) LSSU .DESCRIP COSCS$B_DIMCTI) 

; s Bc BASSSSTOP (BASS$K_TOOFEWARG) 

; 4 Bred BASSS$STOP (BASSK_TOOMANARG) ; 

; $3 461 
: 294 pres END; 
; $3? 046 

; 296 04 '¢ 

; 297 0465 ! The coefficients and bounds must be present. 

Be BE gE 
: 4 Bees IF ( NOT (.DESCRIP CDOSCSV_FL_COEFFJ] AND .DESCRIP CDSCS$V_FL_BOUNDSJ)) THEN BASS$STOP (BAS$K_ARGDONMAT); | 
; 302 0470 MULTIPLIERS = DESCRIP CDSCSL_M1]); 

; Sor oka re BOUNDS = DESCRIP CDSCSL_M1] * (XUPVAL*.DESCRIP CDSC$B_DIMCTJ); 

3s 305 047 !' Compute the lower and upper index numbers based on how the array 

: 306 0474 2! is stored. 

; 307 0475 2 !- 

; 308 0476 ¢ 

; $03 0477 IF (.DESCRIP CDOSCSV_FL_COLUMN]) 

: 310 0478 THEN 

3 $13 0479 EGIN 

: \¢ 0480 LOW_INDEX = .DESCRIP COSC$B_DIMCT); 

a 0481 HIGA_INDEX = 1; 

: 314 048 INDER_INCR = -1; | 
3: 315 04835 3 D | 
: 316 0484 ELS 

s Si7 0485 G 
3; 638 0486 LOW_INDEX = 1; 

5 19 0487 HIGA_INDEX = .DESCRIP COSC$B_DIMCT); 

$s oe INDER_INCR = 1; 

g $ : END; 

5 $ 06 it INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

s Se o¢ ! If this is a decimal array, the length is the number of 4 bit digits 

3 04 

; 04 


000 OW 
SSSSSLSSPSSSESE 


WNAAWANNANAW 
WA.AWIAIPO POND 

FUNSZS Se NOUEWN—O 

oo 

Wun & 

m—OO@ 


CDSCS$K_DTYPE_PJ: ! decimal 
BEGIN 
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; 5 3 LENGTH = ( -DESCRIE COSCSW_LE : 

; : IF .DESCRIP CDSC$B_CLASSJ~EQL DSCS$K_CLASS_BFA 

; 506 4 BEGIN 

5 9 0307 4 

; 340 508 5 LENGTH = ( INCR I FROM 1 TO 9 BY 1 DO 

3 341 0509 6 IF .LENGTH LSS (1 * J) 

; re 0510 4 THEN EXITLOOP (1 * .I) ); 

; 34 0511 END; 

3 344 bag END; 

3 345 051 

: Bete CDSCSK prvPe 23: ! record 

: 348 0516 LENGTH = .DESCRIP CDSC$W_LENGTH); 

; 49 0317 IF .DESCRIP CDSC$B_CLASS] EQL DSCSK_CLASS_BFA 
: 351 0519 4 BEGIN 

i 33¢ 0520 4 

; 35 0521 5 LENGTH = ( INCR I FROM 1 TO 9 BY 1 DO 

; 354 05 ¢ 6 IF .LENGTH LSS (1 * .J) 

; 355 0523 4 THEN EXITLOOP (1 * .I) ); 

; 356 0524 3 END; 

3 SST 0525 END; 

3 Soe 0526 

; 329 0527 CINRANGE , OUTRANGE): 

; 360 0528 LENGTH = .DESCRIP COSCS$W_LENGTH; 

; 361 0349 TES; 

3; 36 0530 

; 36 0531 ‘+ ‘ 

3 + b23¢ 2 } Compute the Linear index from the indices provided. 

3 364 0554 " WVALUE_LOCATION = 0; 

3 68 0336 WHILE  (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
; 370 eh 4 INDEX_VALUE = ACTUALPARAMETER (.INDEX_NUMBER + 2); 

; 37 0540 : IF ((. INDEX_VALUE LSS .BOUNDS [(.INDEX_NUMBER - 1)#2]) =! 

: y? O34) 4 Pr (. INDEX_VALUE GTR .BOUNDS C((.INDEX_NUMBER - 1)#*2) + 1))) 
; 23 0348 BASSSSTOP (BAS$K_SUBOUTRAN) ; 

: As 036g VALUE LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
: 379 54 ; 

3 $9 3268 ,, VALUE_LOCATION = (.VALUE_LOCATION®.LENGTH) + .DESCRIP CDSC$A_A0]; 
; 38 550 i Build a descriptor pointing to the value cell in the array. If this 
s 3 551 ' is an array of descriptors, the descriptor is copied, otherwise it 

: 384 23¢ ' is constructed. 

3; 385 55 te 

; 386 554 

3; 387 555 IF (.DESCRIP CDSC$B_DTYPE] EQLU DSC$K_DTYPE_DSC) 

; 388 228 THEN 

3; 389 5 BEGIN 

: 390 228 

; 391 55 MAP 
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; 9 60 VALUE_LOCATION : REF BLOCK (8, BYTE); 

: 394 64 VALUE_DESCR CDSCS$W_LENGTH] = .VALUE_LOCATION CDSC$W_LENGTH); 

3; 395 6 VALUE_DESCR DSCSBDTYPE, = .VALUE_COCATION COSC$B8_BTYPE); 

; 3% 64 4 VALUE-DESCR CDOSC$B~CLASS) = (ie (.VALUE_LOCATION CBSC$B_CLASS] EQLU DSCSK_CLASS_D) THEN DSCS$K_CLASS_ 
; 397 565 ECSE VALUE LOCATION cose B_CLASSJ); 

: 398 0566 VALUE_DESCR COSCSA_POINTER] = .VALUE_LOCATION CDSCSA_POINTER); 
; 399 6 VALUE-DESC_ADDR = ;VALUE_LOCATION; 

; 400 0368 IF .VALUE_BESCR CDSCS$B_DTYPE] EQL DSCSK_DTYPE_P 

; 401 26 HEN 

; 40 9370 ‘ BEGIN 

: 404 0374 4 VALUE LOCATION : REF BLOCK (12,B8YTE]; 

; 405 0573 4 VALUE_DESTR COSC$B_SCALE] = .VALUE_LOCATION CDSC$B_SCALE); 
; 406 0574 END; 

3; 407 0575 END 

: tes §378 ELSE GIN 

: 410 0578 VALUE_DESCR CDSC$W_LENGTH] = .DESCRIP CDSC$W_LENGTH); 

> 411 0579 VALUE_DESCR CDSCSR_DTYPE] = .DESCRIP CDSC$B_BTYPE); 

; ie 0580 VALUE_DESCR CDSC$B_CLASSJ = DSCS$K_CLASS S; 

3 41 0581 LUE-DESCR CDSCSA-POINTER] = .VACUE_LOCATION; 

: 414 0382 VALUE-DESC_ADDR = VALUE _DESCR; 

: 415 058 IF .VALUE_BESCR COSC$B_BTYPE] EQL DSCSK_DTYPE_P 

: 416 0584 EN 

ip BEE se 

> 419 0587 4 DESCRIP : REF BLOCK [12,BYTE]; 

: 420 0588 4 VALUE_DESCR CDSC$B_SCALE] = .DESCRIP CDSC$B_SCALE); 

F $s 0589 D; 

, é ; 0590 END; 

. ae 

; 425 9338 i Make sure that the data type of the array element agrees with 

: 426 0594 ! that of the result descriptor. 

i O38 gee 3 

; 429 0597 IF (.VALUE_DESCR CDSC$B_DTYPE] NEQU .VALUE CDSCS$B_DTYPE]) THEN BASSSSTOP (BASSK_DATTYPERR); 
4 431 $338 '¢ 

; $36 0600 i Special handling if this is a virtual array. 

: oa boo2 3 

; 435 0608 IF (.DESCRIP CDSCS$B_CLASS] EQLU DSC$K_CLASS_BFA) 

Fe 4 THEN 

3 14 60 BEGIN 

: 639 060? IF (DESCRIP CDSC$B_DTYPE] EQLU DSCSK_DTYPE_DSC) THEN BASSS$STOP (BASSK_NOTIMP); 
eB RB. 

; rr Oei0 If this is a string, remove trailing NULS when fetching it. 

: 664 1 . 

: rr 0618 : IF (DESCRIP CDSC$B_DTYPE] EQL DSC$K_DTYPE_T) 

s 4 

: 667 6615 4 BEGIN 

; 668 0616 4 


——————_—_——_—___—— 
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14-Sep- 6:46 

L 

TEMP_DESC : BLOCK (8, BYT 

DATA_BUF : REF VECTOR PLSE3s, BYTE), 
TEMP_DESC [DSC$W_LENGTH] = 0; 
TEMP—DESC DSC$B_DTYPES = DSCSK_DTYPE_T; 
TEMP-DESC EDSCS$BICLASS] = DSCSK-CLASS-D: 
TEMP-DESC CDSCSA-POINTER] = 0; 
STRSGET1_DX (DESCRIP COSCSW_LENGTH], TEMP_DESC); 
BASSSVA_FETCH (.DESCRIP, . 


ret Bliss-32 V4.0- 
BASRTL.SRCJBASVIRTUA 


VALUE _LOCATION,~.TEMP_DESC CDSC$A_POINTER)); 


Now that we have it in temporary storage, remove its trailing NULs 


'¢ 


LEN = .TEMP_DESC CDSC$W_LENGTHI; 
DATA_BUF = [TEMP_DESC COSCSA_POINTER); 


WHILE ((.LEN GTR 0) AND (.DATA_BUF C.LEN = 1] EQL 0)) DO 
LEN = .LEN = 1; 


Send the shortened string to the user. 


'¢ 


i Copy the array element to the value cell. 


STRSCOPY_R (.VALUE, LEN, .DATA_BUF); 


14 
Deallocate our temporary string. 


STRSFREE1_DX (TEMP_DESC); 
END 


BEGIN 
-DESCRIP CDOSC$B_DTYPE] NEQ DSCSK_DTYPE_P 


N 
: BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, .VALUE [DSCSA_POINTER]) 
> BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, .VALUE); 


BEGIN 
IF (DESCRIP CDSCSB_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$SSTOP (BASSK_NOTIMP); 


} based on the type of data. 


CDSC$K_DTYPE_B) : 
BLOCK C.VALUE CDSCS$A POINTER}. 0 
= .BLOCK C.VALUE_DESTR 


COSCSK_DTYPE WJ 


byte 
ZBPUNIT 


The form of the copy is 
CASE VALUE CDOSC$B_DTYPE] FROM DSCSK_DTYPE_Z TO DSCSK_DTYPE_H OF 


1 
, 0 _" 
DSCSA_POINTER], 0, 0. %BPUNIT, 1); 


: ! 16-bit word 
BLOCK C.VALUE COSCSA_POINTER], 0, 0, %BPVAL/2, 1) : 


7 


’b92:1 


a 


—————————_—————— 
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; of a = .BLOCK C.VALUE_DESCR COSCSA_POINTER], 0, 0, %BPVAL/2, 1); 

; 508 7 COSCSK_DTYPE_L] : ! 32=bit Longword 

; 509 7 BLOCK C.VALUE CDSCSA_POINTF®2, 0 3 ZBPYAL 99 ! 

; 19 t = ,BLOCK C.VALUE_DESCR CDSCSA_POINTER], 0, 6, 28PVAL, 1); 

3 \¢ 0 CDSCS$K_DTYPE_F] : ' 32-bit floating point 

; \3 06 1 BASSSCOPY_F_R1 (.VALUE_DESCR CDSCSA_POINTERJ, .VALUE CDSCSA_POINTER)); 
: §15 06 : CDSCSK_DTYPE_D) : ! 64-bit double floating 

: 16 O86 BASSSCOPY_D_R1 (.VALUE_DESCR CDSCSA_POINTERJ, .VALUE CDSCSA_POINTER)); 
: 518 be CDSCS$K_DTYPE_G) : 1G floating 

3 19 0687 BASSSCOPY_G_R1 (.VALUE_DESCR CDSCSA_POINTERJ, .VALUE CDSC$A_POINTER)); 
3; 521 0689 CDSCSK_DTYPE_H) : ' H floatin 

; 5 ¢ 9690 BASSSCOPY_H_R3 (.VALUE_DESCR CDSCS$A_POINTER], .VALUE CDSCSA_POINTER)); 
3 2 4 069 CDOSCSK_DTYPE_T, DSCSK_DTYPE_72) : ! Text string or record 

: 525 0693 STRSCOPY-DX (.VALOE, .VALUE_DESC_ADDR); 

: é § 0695 CDSC$K_DTYPE_P) : ! decimal 

; 528 0696 4 BEGIN 

: 3¢9 0697 4 LOCAL 

s 330 0698 4 COUNT; 

; 531 0699 4 COUNT = .VALUE_DESCR CDSC$B_SCALE] - .VALUE CDSC$B_SCALE); 

; 238 0700 4 ASHP (COUNT, VALUE DESCR CDSC$W_LENGTH 

3; 5 0701 4 .VALUE_DESCR COSCSA_POINTERT, ZREF(O), VALUE CDSC$W_LENGTHI, 

3; 534 0702 4 . VALUE” CDSCSA_POINTER); 

: 535 070 END; 

; 536 0704 

; 537 0705 CINRANGE, OUTRANGE) : 

; 538 0706 BASS$STOP (BASS$K_DATTYPERR); 

; 239 0707 

; 540 0708 TES; 

: 341 0709 

: 4¢ 0710 2 END; 

; #54 0711 2 

: 544 0712 1 END; ! end of BASSFETCH_BFA 


TITLE BASSY IRTUAL ARR 
-IDENT \1-0335\ 


.EXTRN BASSSSTOP, BASSSCOPY_F_R1 
-EXTRN BASS$SCOPY_D_R1, BASSSCOPY_G_R1 
-EXTRN BASSSCOPY-H-R3, BASSSVA_FETCH 
-EXTRN BASSSVA STORE. STRSGET1_ DX 
-EXTR DX, STRSCOPY_BXx 
“EXTRN STRSCOPY_R, STRSCONCAT 

-EXTRN STRSDUPL CHAR.  BASSK MATARRTOO 


-EXTRN BASSK"DATTYPERR 
-EXTRN BASSK~TOOFEWARG 


N15 
ASSVIRTUAL_ARR 16-Sep-1986 01:29:44  VAX=11 Bliss-32 v4.0-74 p 
pasty 1e-ep- ibe F1i8eiee — EAsRte Sat eagviniua.o%2;1 _ (Pee 


SEXTRN BASSK-ARGDONMAT 
XTRN BASSK-FLOPOIERR 

SEXTRN BASSK-RECBUCLOC 

EXTRN BASSK-ONEOR TWO 

EXTRN BASSK~NOTIMP 

-PSECT _BASSCODE,NOWRT, SHR, PIC,2 


is BASSK_TOOMANARG 


OFFC 00000 ENTRY BASSE ETCH BFA, Save R2,R3,R4,R5,R6,R7,RB8,- =; 0389 
R9_.R10,RIT : 
5 1¢ ¢2 9002 SUBL2 #26, SP ; 
6¢ A 000 HOV ZL (APS, RO + 0452 
5 0 C3 0008 SUBL : 
5 04 AC 00 00008 MOVL DESCRIP, R6 : | 
5 a8 9A OOO0F MOVZBL 11(R6), R2 g 
§ 50 D1 00013 CMPL = RO, -R2 : 
i¢ 13 0016 BEQL ; | 
50 6C 9A 0001 MOVZBL ‘(AP), RO + 0456 
50 08 Ce 90018 SUBL2 #2, RO ; 
52 50 D1 OOO1E CMPL «= RO. R2 : 
06 1€ 00021 BGEGU 1$ : 
7E 006 8F 9A 900 3 MOVZBL M#BASSK_TOOFEWARG, -(SP) + 0458 
04 11 00027 BRB : 
7E 006 8F 9A 00029 1$: MOVZBL #BASS$K_TOOMANARG, =(SP) > 0460 
000000006 00 01 FB 0002D 3: CALLS #1, BASSSSTOP . : 
05 OA Ab 06 E} 0034 3$: BBC #6. 10(R6), 4$ > 0468 
0A Ab 95 00039 TSTB =—_: 10 (R6) : 
0B 19 0003C¢ BLSS : 
7E 006 8F 9A OO03E 4S: MOVZBL #BASS$K_ARGDONMAT, -(SP) : 
000000006 00 01 FB 0004 CALLS #1, BASSS$STOP : 
5 14 A6 YE 00049 S$: MOVAB g0(R6) LTIPLIERS + 0470. 
57 14 A642 DE 00040 MOVAL  20(R6)CR2}, BOUNDS + 0471) 
0B OA 6 0S €1 0005¢ BBC #5, 10(R6). 6$ : 0477 
51 52 dO 0005 MOVL R2, LOW INDEX : 0480 
50 01 DO 0005A MOVL #1, HIGA_INDEX 3 048 
5A 01 cf 00050 MNEGL #1, INDER_INCR ; 048 
09 11 00060 BRB 7$ 3 047 
51 o1 D0 00062 6$: MOVL #1, LOW INDEX : 048 
50 2 dO 0006 MOVL 2, HIGA_INDEX : 048 
SA gt 00 00068 MOVL. #1, INDER_INCR 0488 | 
53 51 A ¢ 0068 7$: SUBL3 JNDEX_INCR LOW_INDEX, INDEX_NUMBER + 0491 | 
6E 02 Ab 9A 0006F MOVZBL 2(R6)> (SPS > 049 
1¢ 90 6E 8F 0073 CASEB. (SP), #0, #28 : 
003A 003A 003A 006 0077 8$ WORD 12$-8$, ; 
003A 003A 003A 003A 007F 9$-8$,- ; 
3A 003A O3A O3A 0087 9$-8$.- ; 
003A 003A 003A O3A O08F 9$-8$,- ; 
3A 003A O3A O3A 00097 9$-8$.- : 
90 A 003A 0042 O3A 009F 9$-8$.- ; 
O3A 003A O3A O3A OOA7 9$-8$,- : 
003A OOAF 9$-8$.- F 
9$-8$.- : 
9$-8$,- 3 
9$-8$,- 3 
9$-8$.- : 
9$-8$.- ; 
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02 


000000006 
BF 


000000006 


08 
000000006 


000000006 
04 


00 
AE 
50 


50 


10 


020E0000 
OC 
08 
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rent Bliss-32 pls 
BASRTL.SRC SBASVIRTUA.B52;1 


EX_VALUE, RO, VALUE_LOCATION 


GTH, VALUE_LOCATION, RO 
R6), RO, VALUE_LOCATION 


LUE LOCATION), VALUE_DESCR 
ALUE_LOCATIONS, VALUE_DESCR+2 
ALUEZLOCATION). #2 


VALUE_LOCATION), RO 

, VALOE_DESCR+3 

4(VALUE_LOCATION), VALUE_DESCR*4 

VALUE_LOCATION, VALUE_DESC_ADDR 

VALUE_DESCR+2, #21 
(VALUE_LOCATION), VALUE_DESCR+8 


RB, VALUE_DESCR 
(SP), VALUE DESCR+2 
E_DESCR+ 


#1, VALU 

VALUE_LOCATION, VALUE _DESCR+4 
VALUE_DESCR, VALUE_DESC_ADDR 
VALUE_DESCR+2, #21 

8(R6), VALUE_DESCR+8 

VALUE, 

VALUE _DESCRO2, 2(R5) 
M#BASSK_DATTYPERR, -(SP) 


#1, BASSSSTOP 
3(R6), #191 


R7, 28$ 
#BASSK_NOTIMP, -(SP) 
#1, BASSS$STOP 

(SP), #14 

434471936, TEMP_DESC 
TEMP_DESC+4 
TEMP_DESC 

#2, STRSGET1_DX 
TEMP_DESC+4 
VALUE_LOCATION 

#3, BASSSVA_FETCH 
TEMP_DESC, EEN 
TEMP_DESC #4, DATA_BUF 


$ 
LEN, DATA_BUF, R1 


Be Se Se Se Oe Ge Se Ss Se Se Be Ge SH se Se Se Se Se He Se Se Se Se Se Be Se Be Be Se Be Se Se Se Se Se Se Fe Se Be Be Se Se Se Se Se Se Si Se Se Se Se Ge Se Be Se Se Be 


0631 
0652 
0634 
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| BASSYTRTUAL ARR 
| 1-03 


000000006 00 
000000006 00 


000000006 00 


04 

7E 

000000006 00 

1¢ 00 
003A 003A 
0046 003A 
0058 Q03A 
0094 O03A 
003A 003A 
003A Q0A0 
003A 003A 


7E 
000000006 00 


D 16 
16-Sep- 
14-Sep- 

FF Al 95 00208 
05 is 020 
04 AE 07 0021 
ge 11 0021 
0 pp 0215 30$: 
08 ae F 0021 
55 DD OO2TA 
03 FB 00 i 
08 AE 99F 00 
01 FB 00226 
6 oF 6 4 31$ 
65 13 86 ¢ 
04 AS 0D 00233 
38 OD 00938 328 
52 DD ieee 3: 
56 DD 00235C 
03 FB bosze 
04 ost? 
03 Ab 91 00246 34$: 
0B 13 0024A 
00G 8F 9A 0024C 
01 FB 80520 
02 AS 8F 00257 35$: 
0094 0025C 36$: 
003A 00264 
0052 0026C 
003A 00274 
003A 0027C 
003A 00284 
003A 0028C 
0085 00294 


00G 8F 9A 88 96 37%: 
01 FB 0029A 
04 002A1 


4 9199308 ee Bliss-32 bp Ei Page 15 
4 11:56:46 BASRTL.SRCJBASVIRTUA.B32;1 (3) 
TSTB -1(R1) : 
BNEQ 30$ : 
DECL N 3; 0635 
BRB $ : 
PUSHL_ DATA_BUF 3 0640 
PUSHAB LEN : 
PUSHL R : 

ALLS #3, STRSCOPY_R : 
PUSHAB TEMP_DESC 3; 0644 
CALLS #1, STRSFREE1_Dx : 

RE : 0613 
CMPB (SP), #21 : 0648 

EQL 32$ : 
PUSHL 4(R5) 3; 0650 

RB 33$ : 
PUSHL RS 3; 0652 
PUSHL VALUE_LOCATION : 
PUSHL s 
CALLS #3, BASSSVA_FETCH : 

ET 3; 0613 
Se or (R6), #4 ; 0658 
MOVZBL #BASSK_NOTIMP, -(SP) : 
CALLS #1, BASS$S$STOP : 
CASEB 2(RS), #0, #28 > 0665 
<WORD  45$-36$,- : 

453-308" ; 
7$-36$,- Z 
37$-36$,- 3 
37$-36$,- 3 
313-368 - : 
8$-36$,- : 
39$-36$,- : 
40$-36$,- 3 
37$-36$,- : 
41$-36$,- F 
42$-36$,- 3 
37$-36$,- 3 
37$-36$,- 3 
45$-36$,- 3 
313-203-~ : 
37$-36$,- $ 
7$-36$,- . 
8 at So : 
7$-36$,- : 
Ht sak + 5 
46$-36$,- F 
7$-36$,- 3 
7$-36$,- s 
7$-36$,- 3 
7$-36$,- : 
7$-36$,- 3 
43$-36$,- 3 
44$-36$ 5 

MOVZBL #BASSK_DATTYPERR, -(SP) ; 0706 

CALLS #1, BASSSSTOP : 


16 
_ BASSVIRTUAL_ARR ihese =1984 01:29:44 AX-11 Bliss-32 v4.0-74 Page 16 
1038 12-80-1984 or 6:46 YBASRTL SRE BASVIRTUA.B32;1 9 3) 
04 85 146 BE 30 0 a2 38$: MOVE @VALUE_DESCR+4, @4(R5) : 0670 
04 85 16 BE 80 0 AB 39$: OVW @VALUE_DESCR+4, @4(R5) + 0674 
04 85 14 BE b0 0 AE 40$: MOVL @VALUE_DESCR+4, a4(R5) : 0678 
51 04 AS DO 002B4 41$ MOVL  4(RS), R1 + 0681 
50 14 AE DO 00288 MOVL § VALUE_DESCR+4, RO : 
000000006 00 i6 00 e 158 BASSSTOPY_F_Ri : 
51 04 AS 00 002C3 42$:  MOVL 4(R5), R1 + 0684 
50 14 AE DO 90 C7 MOVL - VALUE_DESCR+4, RO : 
000000006 00 16 902cB JSB BAS$STOPY_D_Ri : 
04 00201 RET : 
51 04 AS DO 00202 43$ MOVL 4(R5), R1 + 0687 
50 14 AE DO 90206 MOVL VALUE. DESCR+4, RO ; 
000000006 00 16 O02DA JSB BASSSTOPY_G_Ri : 
04 002E0 RET ; 
51 04 AS DO O02E1 44$:  MOVL 4(R5), R1 + 0690 
50 14 AE DO O02E> MOVL §- VALUE_DESCR#4, RO ; 
000000006 00 16 002€9 JSB BASS$SCOPY_H_R3 : 
04 OO2EF RET F 
54 DD 002FO 45$ PUSHL VALUE_DESC_ADDR + 0693 
55 DD 002F2 PUSHL : 
090000006 00 02 FB 002F4 CALLS #2, STRSCOPY_Dx : 
04 002FB RET ; 
50 18 AE 98 OO2FC 46$:  CVTBL VALUE_DESCR+8, COUNT : 0699 
51 08 AS 98 00300 CVTBL 8(R5)> RI ; 
50 51 C2 00304 SUBL2 1, COUNT : 
00 14 BE 10 AE 50 F8 00307 ASHP COUNT, VALUE_DESCR, @VALUE_DESCR+4, #0, - 3; 0702 
04 BS 65 0030 (R5), @4(R5) F 
04 00311 RET : 0712 


; Routine Size: 786 bytes, Routine Base: _BASSCODE + 0000 


3; 545 0713 «#1 


91: 9:44 rest Bliss-32 Vaiva-b$2:1 


F 16 
BASSYIRTUAL ARR 16=Sep=1 
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3; 547 714 1 GLOBAL ROUTINE BASSSTORE BFA ( tore a value by descriptor 
; 548 715 4 LUE : REF BLOCR (8, BYTE) here to find the value 
: 549 ae DESCRIP : REF BLOCK (8, BYTE), he descriptor to store it 
3 550 re. INDEX1 irst index 
3 é) gris 1 ) : NOVALUE = 
; ¢ 0719 #1 
; 0720 1 !++¢ 
> 554 Bf 1 1 =! FUNCTIONAL DESCRIPTION: 
3 Dee 7 ; 1! 
; 556 07 1: Store a value in an array or virtual array. The location from 
3 eee 4 : ' which to fetch the value is passed by descriptor. 
: 286 07 $ 1 ! FORMAL PARAMETERS: 
; 560 07 1! 
; 561 0728 1! VALUE .rx.dx The place from which to get the value stored 
3 206 8585 1! DESCRIP.rx.da The descriptor of the array or virtual arra 
3s 36 0730 1! INDEX1.rl.v The first index into the array. More indicies 
> 564 0731 1! may follow this one in the ca.ling sequer<e. 
3 365 Or 36 1! 
; 566 0733 1 =! IMPLICIT INPUTS: 
; 567 0734 1! 
; 568 0735 1! NONE 
> 569 0736 1! 
3; 370 0737 1 ! IMPLICIT OUTPUTS: 
3 STi 0738 1! 
s Sve 0739 1! NONE 
3 S73 0740 1! 
3 574 0741 1 ! ROUTINE VALUE: 
ie 1) toes 1 ! COMPLETION CODES: 
> 576 07435 1! 
s Sr 0744 1! NONE 
; 578 0745 1! 
; 579 0746 1 ! SIDE EFFECTS: 
) 0747 1! f : 
: 0748 1! Signals if an error is encountered. 
3 236 0749 1! 
; 0750 1 !-- 
; 584 0751 +1 
3 3e9 b72¢ 2 BEGIN 
> 586 075 
; 587 0754 UILTIN 
; 588 0755 ACTUALCOUNT 
; 589 0756 ACTUALPARAME TER, 
: 590 0757 ASHP; 
; 9) 0758 
3 236 0759 LOCAL 
7; 0760 INDEX_VALUE 
; 594 0761 VALUE-LOCATION, 
3 395 0768 MULTIPLIERS : REF VECTOR, 
; 596 076 BOUNDS : REF VECTOR, 
: 597 0764 LOW INDE 
; 598 0765 HIGR_INDEX, 
; 599 0766 INDER_INCR 
; 600 0767 INDEX~NUMBER, 
; 601 0768 VALUE_DESCR : BLOCK (12, BYTE], 
; 602 0769 VALUE _DESC_ADDR, 
; 603 0770 2 LENGTRA; 
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; 604 0771 

; 605 at ‘4 

$ O06 77 ! Be sure the number of array subscripts matches the number of 

; 60 774 ! indicies given to us. 

; 608 0775 le 

; 609 b776 

; 610 077 IF (CACTUALCOUNT () = 2) NEQU .DESCRIP CDSC$B_DIMCTI) 

3 $61) 0778 THEN 

; oi¢ 0779 BEGIN 

3; $61 Bree 

; ere 44 4 IF (CACTUALCOUNT () = 2) LSSU .DESCRIP CDSC$B_DIMCTI) 

> 616 $785 BASSSSTOP (BAS$K_TOOFEWARG) 

; 617 0784 ELSE 

; 618 0785 BASSSSTOP (BAS$K_TOOMANARG) ; 

; 619 0786 3 

; 620 0787 END; 

; 621 0788 

3 ose 0789 '¢ 

; 62 0790 ! The coefficients and bounds must be present. 

: 65s Oren 3 

; 626 0798 2 IF ( NOT (.DESCRIP CDSCSV_FL_COEFF] AND .DESCRIP CDSC$V_FL_BOUNDSJ)) THEN BASSS$STOP (BASSK_ARGDONMAT); 
> 628 0795 : MULTIPLIERS = DESCRIP CDSCS$L_M1]; 

5 $¢° 6739 i a BOUNDS = DESCRIP CDSC$L_M1] * (XZUPVAL*.DESCRIP COSC$B_DIMCT)); 

3 0798 ! Compute the lower and upper index numbers based on how the array 

; 632 0799 ! is stored. 

; 633 0800 !e 

3; 634 0801 

; 635 080 IF (.DESCRIP COSCS$V_FL_COLUMN]) 

; 636 080 THEN 

3; 637 0804 BEGI 

; 638 0805 LOW_INDEX = .DESCRIP CDSC$B_DIMCTI; 

; 639 0806 3 HIGA_INDEX = 1; 

; 640 0807 3 INDER_INCR = -1; 

> 6461 0808 3 END 

; pak 0809 EL 

; 64 0810 BEGIN 

3 644 0811 LOW INDEX = 1; 

3; 645 oai¢ HIGA_INDEX = .DESCRIP COSC$B_DIMCT); 

; 646 0813 3 INDER_INCR = 1; 

3; 647 ste END; 

3; 648 815 

3 66 bai$ INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

; 651 0818 ! If this is a decimal array, the length in the descriptor is the number of 
3 636 $4 BAT (not including the sign). Convert this length to the number 
3 !o es. 

3 654 oe 1 ! Also. if this is a virtual array, the size must be a multiple of 2. This 
; 633 os § is true for arrays of records as well. 

3; 657 Oe 4 CASE .DESCRIP CDOSCS$B_DTYPE] FROM DSCSK_DTYPE_Z TO DSCSK_DTYPE_H OF 

; 658 825 SET 

3; 659 08 § : 

; 660 082 CDOSCSK_DTYPE_P) : ! decimal 
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661 08 § BEGIN 
666 08 LENGTH = Fig td 4 COSC$W_LENGTHJ/2) + 1; 
66 08350 IF .DESCRIP CDSC$B_CLASS] EQL DSC$K_C ASS_BFA 
664 0831 THEN 
665 08 ¢ BEGIN 
666 08 
667 0834 LENGTH = ( INCR I FROM 1 TO 9 BY 1 DO 
ges nee Phen Ext Ttobe C1 3 iD) 
N we : 
670 0837 END; 
671 0838 END; 
67 + He 
67 840 COSCSK_DTYPE_2) : ! record 
674 0841 BEGIN 
675 Bas LENGTH = .DESCRIP CDSC$W_LENGTH]; 
676 084 IF DESCRIP CDSC$B_CLASSJ EQL DSCSK_CLASS_BFA 
677 0844 THEN 
678 0845 BEGIN 
679 0846 
680 0847 LENGTH = ( INCR I FROM 1 TO 9 BY 1 DO 
681 084 IF .LENGTH LSS (1 * .I) 
682 0849 THEN EXITLOOP (1 * .I) ); 


; 085 
; 085 
: 085 
; 689 085 
; 085 
: 085 
: 085 


END; 
END; 


CINRANGE, OUTRANGE) : 
at LENGTH = .DESCRIP CDSC$W_LENGTH); 


14 
Compute the linear index from the indices provided. 


VALUE_LOCATION = 0; 
WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
INDEX_VALUE = ACTUALPARAMETER (.INDEX_NUMBER + 2); 


IF ((. INDEX VALUE LSS .BOUNDS C(.INDEX NUMBER - 1)*2]) ! 
OR (.INDEX_VALUE GTR .BOUNDS (((.INDEX_NUMBER - 1)*2) + 13)) 


HEN 
BASSSSTOP (BAS$K_SUBOUTRAN) ; 
Pa LAAT Ie = (.VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER - 1]) + .INDEX_VALUE; 


69 0860 
6 


VALUE _LOCATION = (.VALUE_LOCATION®.LENGTH) + .DESCRIP CDSC$A_A0]; 


Build a descriptor pointing to the value cell in the array. If this 
! is an array of descriptors, the descriptor is copied, otherwise it 
;_1S constructed. 


'¢ 
: 


IF (.DESCRIP CDSC$B_DTYPE] EQLU DSCSK_DTYPE_DSC) 
BEGIN 


WAI FIPIIPINPIPININININININIWIWI WE III AIRIPIPIPIAIPIPINPIPUNIPINIWW ES AUS BWANA EF OUE SW 


Nee 8S aE, Re oe eeeen ees 
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pasey ease 8-196 f1:8e:46 — POASRTe sae aeASvyRT OA 6S251 a 

718 0885 P 

9 08 6 VALUE_LOCATION : REF BLOCK (8, BYTE]; 

721 0888 VALUE_DESCR [DSC$W_LENGTH] = VALUE LOCATION Cos¢su LENGTH]; 

7 ‘ 0889 UE-DESCR DSC$B-DTYPE] = .V E SCOCATION N Coscse BT 

7 0890 VALUE~DESCR CDSCS$B~CLASS) = uP ve LOCATION BScsB° Ciass] EQLU DSCSK_CLASS_D) THEN DSC$K_CLASS_ 

724 891 ECSE VALUE LOCATION Cosc$B CLAS 

725 0 % ALUE_DESCR COSCSA_POINTER] = .QALUE a stom CDSCS$A_POINTER); 

726 089 VALUE-DESC_ADDR = sVALUE LOCATION; 

727 0894 IF_.VALUE_BESCR CDSCS$B_DTYPE] EQL DSC$K_DTYPE_P 

728 0895 THEN 

729 0896 BEGIN 

730 089 AP 

731 0898 EehOGATION. : REF BLOCK (12,BYTE] 

7 é 0899 VALUE ADEStR DSC$B_SCALE] = .VALUE “LOCATION CDSC$B_SCALE); 

f3 0900 END; 

734 0901 END 

735 090 ELSE 

736 090 BEGIN 

737 0904 VALUE_DESCR CDSC$W_LENGTH] = .DESCRIP CDSC$w LENGTH); 

738 0905 VALUE ~DESCR DSC$B_DTYPE] = .DESCRIP CDSC $B BTY 

739 0906 VALUE-DESCR CDSC$B-CLASS] = DSCS$K_CLASS 

740 0907 VALUE-DESCR CDSCSA-POINTER] = VALUE APOtATION: 

741 0908 VALUE~DESC_ADDR = QVALUE_DESCR; 

rag 0909 IF .VALUE_BESCR CDOSCSB_BTYPE] EQL DSCSK_DTYPE_P 

74 0910 EN 

74h 0911 BEGIN 

745 091 P 

DESCRIP : REF BLOCK [12, Bvt TE); 

747 0914 VALUE_DESCR CDSC$B_SCALE] = .DESCRIP CDSCS$B_SCALE); 

748 0915 END; 

749 0916 END; 


: : 
: : 
: 


make sure that the data type of the array element agrees with 
g that of the source descriptor. 
IF (.VALUE_DESCR CDSC$B_DTYPE1 NEQU .VALUE CDSC$B_DTYPE]) THEN BASSSSTOP (BASSK_DATTYPERR); 
'¢ 
i Special hand!ing if this is a virtual array. 
ee CDSCSB_CLASS] EQLU DSC$K_CLASS_BFA) 
BEGIN 
IF (DESCRIP COSC$B_DTYPE] EQLU DSCSK_DTYPE_DSC) THEN BASSS$STOP (BASSK_NOTIMP); 
'¢ 


i If this is a string, we must pad it with NULs. To do this, we need 
if a temporary string. 


NN 
NN 
-S 
ooooo°oooo 
000550550 
RWWA 
=OODNOAUE WN 


a aecetl COSCSB_DTYPE] EQL DSC$K_DTYPE_T) 


47 
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; 942 4 BEGIN 
3 945 & 
4 944 4 CAL 
$ 945 & NULLS. COUNT, 
; Be8 4 TEMP_BESC : BLOCK (8, BYTE); 
3 947 & 
$ 948 4 t+ 
; 344 ? ‘ Copy the caller's string to our temporary. 
; 0951 4 TEMP_DESC COSCS$W_LENGTH] = 
; 099¢ 4 TEMP-DESC CDSCSB-DTYPE) = pei sx _DTYPE_T; 
: 832 4 TEMP_DESC LDSC$B_ pe ate a] 5 Seek. CLASS_ D; 
: 954 4 TEMP- DESC Det san POINT 
; 0995 pa STRSTOPY_DX (TEMP POESC erty 
; 0387 2 a " Cencetenete enough NULs onto the string to make it the right Length. 
; 3444 : NULLS_COUNT = .DESCRIP CDSCSW_LENGTH] - .TEMP_DESC CDSC$W_LENGTH); 
; 0961 5§ IF (.NULLS_COUNT GTR 0) 
; 0962 4 THEN 
3 0963 5 BEGIN 
3 0964 5 
3 0965 5 CAL 
3 pae8 : NULLS_DESC : BLOCK (8, BYTE]; 
5 0968 : NULLS_DESC CDSC$W “LeNeTud eT; 
5 0969 NULLS_DESC DSC$B_DTYPE] = DSCSK_DTYPE_T 
; 0970 5 NULLS~DESC DSCSB-CLASS) = DSCSK-CLASS “; 
3 0971 5 NULLS DESC CDSCS$A_POINTER] = 0; 
3 0972 § STRSDOPL_CHAR (NUCLS_DESC, %REF (.NULLS -COUNT), ZREF (0)); 
3 097 5 STRSCONCAT (TEMP_DEST TEMP_DESC, NULLS “DES Cie 
; 0974 § RSFREE1_DX (NUCLS_DESC); 
: 0975 4 $ 
3 0976 4 
; 810 0977 4 I+ 
3 ie 944 ? } No. store the (possibly lengthened) string in the file. 
; B18 344 2 a. BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, .TEMP_DESC CDSCSA_POINTER]); 
3; 815 0982 4 ! Free our temporary string. 
; 816 0983 4 !- 
; 817 0984 4 STRSFREE1_DX (TEMP_DESC); 
3 gig 0985 4 
: 819 0986 3 ELSE 
: 820 987 4&4 
: as) Bae ? IF .DESCRIP CDSC$B_DTYPE] NEQ DSCSK_DTYPE_P 
; $58 990 4 BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, .VALUE CDSCSA_POINTER]) 
3 ase 0991 4 ELSE 
3; 825 0992 4 BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, .VALUE); 
3: 826 0993 4 D 
3 534 994 END 
3 8 995 ELSE 
2 on m3 
; 831 0998 IF (.DESCRIP COSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSS$STOP (BASSK_NOTIMP); 


K 16 
gegen 1erSep-1986 1:86:46 — EBASRTLeSReSeASVIRUA682;1 Page és 


; 8 ; 0999 

; 1901 ito the value cell to the a L t. The f f th i 

Py 4 Vv rray element. e form o e co s 

; 5 1008 } based on the type of data. . 4 

: 8 1004 3° 

; 838 1005 CASE .VALUE CDSC$B_DTYPE] FROM DSCSK_DTYPE_Z TO DSCSK_DTYPE_H OF 

; 839 1908 SET 

; 840 100 

; 4841 1008 COSCSK_DTYPE_B) : ' byt 

: ag 1009 BLOCK C.VALUE DESCR CDSCSA_POINTER], 0, 0, %BPUNIT, 1) 

i B45 1019 = ,BLOCK C.VACUE COSCSA_POINTER], 0. 0. %APUNIT, 14; 

: 845 1018 CDSCSK_DTYPE_W) : taJorbit word 

3 846 101 BLOCK C.VALUE_DESCR CDSCS$A_POINTERJ, 0, 0, %BPVAL/2, 1] ! 

; 847 1014 = .BLOCK C.VACUE COSCSA_POINTER], 0. 0, XOPVAL/2, 14; 

: 849 1016 LDSC$K_DTYPE_LJ : Egfe-bit, Longword 

; 850 1017 BLOCK C.VALUE_DESCR CDSCSA_POINTER], 0, 0, XBPVAL, 1] ! 

; 851 1018 = .BLOCK C.VACUE CDSCS$A_POINTERI, 0. 0, %8PVAL, 14; 

; HE 1020 CDSCSK_DTYPE FJ : ! 32-bit floating point 

: 854 1921 BASSSCOPY_F_R1 (.VALUE CDSCSA_POINTER], .VALUE_DESCR CDSCSA_POINTER)); 
: 856 1098 CDSCSK_DTYPE_D) : ! 64-bit double floating 

; Set Ioee BASSSCOPY_D_R1 (.VALUE CDSCSA_POINTER], .VALUE_DESCR CDSCSA_POINTER]); 
: 859 1026 [DSC$K_DTYPE GJ : ube boating 

; 860 10e7 3 BASSSCOPY_G_R1 (.VALUE CDSCSA_POINTER], .VACUE_DESCR CDSC$A_POINTER)); 
; B6¢ 1089 CDSC$K_DTYPE_HJ : utedboating 

5 a7 ios BASSSCOPY_H_R3 (.VALUE COSCSA_POINTERJ, .VALUE_DESCR CDSCSA_POINTER]); 
: 865 1038 CDSC$K_DTYPE_T, DSC$K _DTYPE_2] : ! Text string or record 

; 508 HF STRSCOPY_DX (.VALOE_DESC_ADDR, .VALUE); 

; 868 1035 3 [DSC$K_DTYPE_P) : ! decimal 

; 869 1036 4 BEGIN 

; 870 1037 4 

; 871 1038 4 VALUE : REF BLOCK (12,BYTE); 

; B72 1039 4 LOCAL 

3 87 1040 4 ; 

3 874 1041 4 COUNT = .VALUE COSC$B_SCALE] - .VALUE_DESCR CDSC$B_SCALE); 

: 875 1066 4 ASHP (COUNT, VALUE CDSC$W_LENGTH] VALUE CDSCSA POINTER? 

: are 107 4 ZREF (0); VALUE_DESCR COSCSW_LENGTH), .VALUE_DESCR CDSCSA_POINTER)); 
: 878 1045 . 

; 879 1046 CINRANGE, OUTRANGE) : 

; 880 104 BASS$STOP (BAS$K_DATTYPERR); 

; 881 1048 

; 882 1049 TES; 

; +88 1050 

3; 884 1051 END; 

; 885 105¢ 

; 886 105 END; ! end of BASSSTORE_BFA 


(ee 
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OFFC 00000 .ENTRY BASSSTORE BFA, Save R2,R3,R4,R5,R6,R7,R8,- ; 07146 
5 24 2 9000 SUBL2 a6. + : 
5 6c 9 MOVZBL itt RO : 0777 
5 2 c3 $098 SUBL2. #2 ; 
is 08 AC p 0008 MOVL DESCRIP, R6 : 
5 As A OO00F MOVZBL 11(R6), R2 : 
5 50 01 00013 CMPL = RO, -R2- ; 
ic 13 00016 €& } : 
50 6€ 9A 0001 MOVZBL (AP), RO + 0781 
50 02 ¢2 00018 SUBL2 #2, RO ; 
52 50 01 OO01E PL RO. R2 : 
06 1£ 00021 BGEGU : 
7E 006 BF A 900 : MOV ZBL #BASSK_TOOFEWARG, (SP) : 0783 
7E 006 SF 9A 00029 1$: MOVZBL M#BASS$K_TOOMANARG, -(SP) + 0785 
000000006 00 01 FB 00020 2$: CALLS #1, BASS$STOP : 
5 OA Ab 06 7 00034 3$: BBC #6. Oe R6), 4$ : 0793 
0A A6 5 00039 TSTB 10(R6) s 
0B 19 0003C BLSS $ : 
7E 006 8F 9A OO03E 4$ MOVZBL #BASSK ARGDONMAT, -(SP) : 
000000006 00 01 FB 0004 CALL BASSS 3 
55 146 Ab YE 00049 S$: MOVAB going) Sor TeLIERS + 0795 
57 14 A642 DE 0004D MOVAL  20(R6 dtRed, BOUNDS ; 07 
0B 0A Ab 05 €1 0005 BBC #5, 10(R6), 6$ ; 080 
51 52 dO 0005 MOVL R2.L Ai NDEX : 080 
50 01 DO 0005A MOVL #1, H HIGA INDEX + 0806 
59 01 CE 0005p MNEGL #1, INDER_INCR : 0807 
09 11 00060 BRB 7$ + 0802 
51 01 DO 00062 6$ MOVL #1, LOW INDEX > 0811 
50 52. 00 0006 MOVL R2, HIGA_INDEX : 081 
59 01 D0 00068 MOVL. #1, INDER INCR > 081 
52 51 59 C3 00068 7$ SUBL3.  INDEX_ INCR, LOW_INDEX, INDEX_NUMBER : 0816 
04 AE 02 A6 9A 0006F MOVZBL 2(R6)7> 4(SP) + 0824 
1C 00 04 AE B&F 00074 CASEB. 4(SP) Pe #28 ; 
003A 003A 0066 00079 8$: <WORD 12$-8$,- : 
003A 003A 003A 00081 9$-8$,- F 
3A 003A 003A 00089 9$-8$,- : 
003A 003A 003A 00091 9$-8$.- ; 
003A 003A 003A 00099 9$-8$.- : 
00 A 0042 005A O00A1 9$-8$.- : 
O3A 003A O3A O0A9 9$-8$.- : 
003A 00081 9$-8$.- : 
9$-8$.- : 
9$-8$,- 3 
9$-8$,- 5 
+ at te : 
9$-8$,- ; 
9$-8$,- : 
9$-8$,- 3 
9$-8$.- ; 
9$-8$.- ; 
+ at a : 
9$-8$,- : 
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6:46 BASRTL.SRC BASv ERT VA. ¥ 2:1 (4) 
+ $,- 3 
Tosca, : 
9$-8$,- : 
9$-8$.- ‘ 
9$-8$.- : 
9$-8$,- 3 
9$-8$,- : 
33-83" 
SA 66 3C 00083 9$: MOVZWL (R6), R10 + 0854 
54 SA D0 9008 MOVL R10, LENGTH : 
49 11 0008 RB 17$ : 
SA 66 3¢ 000BB 10$:  MOVZWL (R6), R10 : 0829 
51 5A 02 C 00086 DIVL3 #2, R10, R1 : 
54 01 Al 9E 000C MOVAB 1(R1), LENGTH : 
BF BF 03 Ag 91 00066 CMPB ss «3(R6). #191 + 0830 
53 31 08 ooocp or. Oe > 0835 
51 01 5 ° 00000 118 ASHL iI, ni. R1 ; 
51 54 D1 00004 CMPL = LENGTH, R1 : 
1F 19 00007 BLSS 148 : 
F3 53 09 £3 00009 AOBLEQ #9, I, 11$ : 
22 11 000DD BRB 16$ > 0834 
SA 66 3C OOODF 12$ MOVZWL (R6), R10 + 0842 
54 5A D0 O00E2 MOVL R10, LENGTH : 
BF BF 03 A6 91 OO0E CMPB 40 s«3(R6), #191 + 0843 
18 12 OOOEA BNEQ 17% : 
53 01 00 OO0EC MOVL #1, I + 0848 
51 07 53 78 OOOEF 13$ ASHL =‘, #1, R1 : 
51 54 D1 000F3 CMPL _—s LENGTH, R1 : 
05 18 000F6 BGEG 15$ : 
54 51 DO OOOF8 148 MOVL R1, LENGTH > 0849 
07 11 000FB BRB 17$ : 
EE 53 09 £3 OOOFD 15 AOBLEQ #9, > 0848 
54 01 CE 00101 16$ MNEGL #1. LENGT : 0847 
53 D4 00104 CLRL_ VALUE_LOCATION > 0860 
58 50 59 C1 90106 ADDL3 INDEX “INCR. HIGH_INDEX, R11 : 0862 
52 59 CO OO10A 18$: ADDL2 INDEXTINCR, INDER_NUMBER : 
58 52 D1 0010D CMPL NDEX"NUMBER, R11 F 
2— 13 00110 BEQL : 
538 08 AC42 06 0112 MOVL CAP) CINDEX ofumBer] INDEX_VALUE + 0864 
50 38 01 0011 ASHL =o #1, ‘I OMBER > 0866 
FB A74 58 D1 00118 CMPL NDEX NVALOE. CBOUNDS) ERO} : 
07 19 0012 BLSS 9$ : 
FC A740 58 D1 O01¢¢ CMPL § _INDEX_VALUE, -4(BOUNDS)CRO) + 0867 
0B 15 001 BLEQ 20 : 
7E 00G 8F 9A 00129 19$:  MOVZBL M#BASS$K_SUBGUTRAN, -(SP) > 0869 
000000006 00 01 FB 01 D CALLS #1, BASSSSTOP : 
0 § FC AS42 C5 00134 208: MULLS -4(MULTIPLIERS)CINDEX_NUMBER), - > 0871 
VALUE _LOCATION, R : 
53 50 58 C1 013A ADDL3 INDEXTVALUE, RO, VALUE_LOCATION : 
CA 11 001 . RB 18$ > 0862 
50 53 54 C5 00140 218 MULL LENGTH, VALUE_LOCATION, RO > 0874 
5 50 10 Ab Ci 00144 ADDL (RO), RO, VALUE_LOCATION : 
52 bs 00149 CLRL OR > 0881 
18 04 AE 91 00148 CMPB 3s G( SP), #24 : 


BASSVIRTUAL _ARR 
3s 


8B 1 
16-Sep-1984 01 
aoe 1 1 é 
H 12 OO14F BNEQ 
D6 00151 INCL 
18 AE 6 34 01 ; MOVW 
1A OA o A 0 001 MOVB 
ant es 
50 83 6 O12 MOVL 
04 11 0016 BRA 
50 03 Ad QA ah 3g: MOVZBL 
1B AE 50 90 00168 23$: MOV 
1¢ A 04 a iv) 4 MOVL 
5 53 00 00174 MOVL 
15 1A Ag 91 00177 CMPB 
at Bp ee BNEQ 
20 =AE 08 A3 90 0017D MOVB 
20 11 00182 Bag 
18 AE 5A B60 Habe 248: MOVW 
1A AE 04 AE 90 00188 MOVB 
1B AE 01 90 0018) MOVB 
1C AE 53 dO 00191 MOVL 
55 18 AE 9E 00195 MOVAB 
15 1A AE 91 00199 CMPB 
05 12 00190 BNEQ 
20 «AE 08 A6 90 0019F MOVB 
57 04 AC DO O01A4 258: MOVL 
02 A? 1A AE 91 001A8 CMPB 
OB 13 OO1AD EQL 
7E 00G 8F 9A OOTAF MOVZBL 
000000006 00 01 FB 00183 CALLS 
BF CF 03 Ab 91 OO1BA 26$: CMPB 
03 13 001BF BEQL 
00A3 31 001C1 BRW 
0B 52 E9 001C4 278: BLBC 
7E 00G 8F 9A 001C7 MOVZBL 
000000006 00 01 FB 001CB CALLS 
OE 04 AE 91 00102 28$: CMPB 
76 12 00106 BNEQ 
10 AE 020E0000 8F D0 00108 MOVL 
14 AE D4 001E0 CLRL 
57 DD 001E3 PUSHL 
14 AE 99F OO1ES PUSHAB 
000000006 00 02 FB 0O1E8 CALLS 
50 10 AE 3C OO1EF MOVZWL 
50 5/ 50 ¢ Sp tES SUBL3 
. a 1F7 BLEQ 
08 AE 020E0001 8F 00 001F9 MOVL 
OC AE D4 B50) CLRL 
04 AE D4 8 04 CLRL 
04 AE 9F 00207 PUSHAB 
04 «AE 50 DO 0020A MOVL 
04 AE 9F OO20E PUSHAB 
10 AE 9F 00211 PUSHAB 
000000006 00 03 FB 00214 CALLS 
08 AE 9F 0021B PUSHAB 
14 AE 9F 8 if PUSHAB 
18 AE 99F 2 PUSHAB 
000000006 00 03 FB 00224 CALLS 


AX-11 a V4.0-7 
BASRTL.SRC ° 


LUE LOCATION), VALUE_DESCR 
ALUE_LOCATIONS, VALUE_DESCR+2 
ALUEZLOCATION), #2 


LOCATION), RO 

DESCR+ 
LOCATION), VALUE_DESCR+4 
CATION, VALUE_DESC_ADDR 
SCR+2, #21 
ALUE_LOCATION), VALUE_DESCR+8 
VALUE_DESCR 

VALOE_DESCR+2 
UE_DESCR+3 
VALUE_LOCATION, VALUE_DESCR+4 
VALUE-DESCR, VALUE_DESC_ADDR 
VALUE _DESCR#2, #21 
eines VALUE _DESCR+8 
VALUE _DESCR#2, 2(R7) 
#BASSK DATTYPERR, -(SP) 


#1, BAS$$STO 
3506), #191 


R2, 28$ 
#BASS$K_NOTIMP, -(SP) 
#1, BASSS$STOP 

4{SP), #14 


#34471936, TEMP_DESC 

TEMP_DESC+4 

TEMP_DESC 

#2, STRSCOPY_DX 

TEMP_DESC, NOLLS_COUNT 

NULLS_COUNT, R107 NULLS_COUNT 
NULLS_DESC 

e+4 


NULLS_DESC 
#3, STRSDUPL_CHAR 


a8 
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0973 


a HF 


BA 
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SVIRTUAL_ARR 
_ yee 


1C 


000000006 00 


000000006 00 
000000006 00 


000000006 00 


000000006 


7E 
000000006 00 
1C OBE 


08 
14 


10 


04 
04 


03 
006 
02 
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oooooo°oo 
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01 
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1 
1bese -1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 

1e-8ep-19 4 11:56:46 BASRTL SRE IBASV RIVA. B42; 1 . (38 
9F 00228 PUSHAB WNULLS_DESC : 0974 

FB 00 E CALLS #1, STRSFREE1_Dx : 
DD 0 29$: PUSHL TEMP_DESC+4 + 0980 

DD 8 PUSHL VALUE_LOCATION ; 

DD 0023A PUSHL R ; 

FB 00 i CALLS #3, BASS$$VA_STORE : 
9F 0024 PUSHAB TEMP DESC 7 0984 

FB 00246 CALLS #1, STRSFREE1_Dx : 
04 0024D RET + 0940 
91 00 4 30$ CMPB =s-«& (SP), #21 : 0988 
bb po5ee ie tte : 0990 

11 6 33 RB 32$ : 
DD 99 59 31$: PUSHL R + 0992 

DD 00258 32$: PUSHL VALUE_LOCATION : 

DD 0025D PUSHL : 

FB 0025F CALLS #3, BASS$VA_STORE : 
04 00266 RET : 0940 
91 00287 33$ CMPB =s-«3(R6), #4 : 0998 

13 00208 BEQL 4$ : 

9A 0026D MOVZBL #BASSK_NOTIMP, =-(SP) : 

FB 00271 CALLS #1, BASS$STOP : 
8F 00278 34$: CASEB 2(R7), #0, #28 : 1005 

00270 35$: <WORD 44$-35$,- : 

00285 36$-35$,- : 

00280 36$-338.- : 

00295 6$-35$,- : 

00290 36$-35$.- ; 

002A5 36$-35$,- : 

002AD 37$-35$,- : 

00285 38$-35$,- : 

39$-35$,- : 

36$-35$,- : 

40$-35$,- : 

41$-35$,- s 

36$-35$,- ; 

36$-35$,- : 

44$-35$,- $ 

36$-35$,- F 

36$-35$,- 3 

36$-355$,- - 

36$-35$,- : 

Beer: | 

783: oe 3 

36$-35$,- : 

6$-35$,- F 

6$-35$,- 3 

6$-35$,- : 

6$- 28.- ; 

rt $.- ; 

43$-35$ 3 
9A 00287 36$: MOVZBL #BASSK DATTYPERR, -(SP) : 1047 

FB 002B CALLS #1, BASS$SSTOP : 

04 99 ¢ RET : 
90 002C3 37$: MOVB @4(R7), @VALUE_DESCR+4 ; 1010 

04 002¢8 RET : 


LL Lt sss 


dD 1 
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1-033 12-80 8= 138 or: 6:46 YBASRTL SRe BASVIRTUA- 62:1 a) 
1C «BE 04 87 80 0 £9 38$: mov @4(R7), @VALUE_DESCR+4 : 1014 
1c «BE 04 87 Bd CF 39$: MOVL @4(R7), @VALUE_DESCR+4 + 1018 
51 1¢ ag 9 DS 40$: MOVL VALUE DESCR+4, R1 + 1021 
50 04 A? D D MOVL 4(R7)7 R : 
000000006 00 i6 D 158 BASSSCOPY_F_R1 : 
51 D0 £4 41$:  MOVL VALUE_DESCR+4, R1 + 1024 
50 04 A? 00 00268 MOVL : 
000000006 00 i6 i: 58 BASS$SCOPY_D_R1 : 
51 1¢ AE 00 § F3 42$: MOVL VALUE_DESCR+4, R1 : 1027 
50 04 A? 00 00 F MOVL 4(R7)> : | 
000000006 00 i6 00 FB 38 BASSSCOPY_G_R1 : | 
51 1¢ AE DO 00302 438:  MOVL = VALUE_DESCR+4, R1 : 1030, 
50 04 A? D0 00306 MOVL R7), R : | 
000000006 00 16 0030A JSB BASS$SCOPY_H_R3 : 
04 00310 RET ; | 
0OAO 8F BB 00311 44$:  PUSHR #*M<RS,R7> + 1033) 
000000006 00 02 FB 00315 CALLS #2, STRSCOPY_Dx ; | 
04 0031C RET : 
50 08 A? 98 0031D 45$:  CVTBL  8(R7), COUNT + 1041. 
51 20 AE 98 00321 CVTBL VALUE DESCR+8, R1 : | 
50 51 C2 00325 SUBL2 1, COUNT : 
00 046 87 67 50 FB 00328 ASHP COUNT, (R7), @4(R7), #0, VALUE_DESCR, - > 1043 
1C «BE 18 AE 0032E @VALUE_DESCR+4 F 
04 00332 RET : 


; Routine Size: 819 bytes, Routine Base: _BASS$CODE + 0312 


; 887 1054 1 


1 
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eAS Sy 1278687138 94588566 EBASRTL SRE BASVIRTUA.B52;1 ’ 3 
g88 1055 1 GLOBAL ROUTINE BASS$STORE BFA_OFF ( ! Store a value by desc w/offset 
90 1926 1 VALUE : REF BLOCR (8, BYTE) ! Where to find the value 
891 1057 1 DESCRIP : REF BLOCK (8, BYTE), i The descriptor to store it 
89 1058 1 OFFSET, ! Offset into record 
89 1059 1 STR_LENGTH, ' String length (if string VALUE) 
894 1060 1 INDEX1 ! First index 
895 1061 1 ) : NOVALUE = 
896 1908 1 
897 1065 1 !+4¢ 
898 1064 1 ! FUNCTIONAL DESCRIPTION: 
899 1065 1! 
900 1066 1! Store a value in an array or virtual array. The location from 
901 1067 1! which to fetch the value is passed by descriptor. This is a special 
308 1068 1! routine to handle record arrays - the offset specifies an element 
90 1069 1! in the record. 
904 1070 1! 
905 1071 1 =! FORMAL PARAMETERS: 
906 1076 1! 
907 1075 1! VALUE .rx.dx The place from which to get the value stored 
908 1074 1! DESCRIP.rx.da The descriptor of the array or virtual array 
909 1075 1! GFFSET.rlu.v Offset into the record 7 
910 1076 1! STR LENGTH. rlu.v Lengsh if hg | VALUE, 0 otherwise . 
911 1077 1! INDEX1.rl.v The first index into the arrey, More indicies 
912 1078 1! may follow this one in the calling sequence. 
913 1079 1! 
914 1080 1 ! IMPLICIT INPUTS: 
915 1081 1! 
916 One 7} NONE 
917 1083 1! 
918 1084 1 ! IMPLICIT OUTPUTS: 
919 1085 1! 
920 1086 1! NONE 
921 1087 1! 
922 1088 1 ! ROUTINE VALUE: 
9235 1089 1 ! COMPLETION CODES: 
924 1090 1! 
925 1091 1! NONE 
926 1936 1! 
927 1095 1 ! SIDE EFFECTS: 
928 1094 1! 
36? 1095 1! Signals if an error is encountered. 
930 199% 1! 
931 1097 1 !-- 
936 1098 1 
93 1099 BEGIN 
934 1100 
935 1101 BUILTIN 
936 1108 ACTUALCOUNT, 
937 110 ACTUALPARAME TER, 
938 1104 ASHP; 
939 1105 
940 1106 § CAL 
941 1107 INDEX_VALUE 
a4 1108 VALUE ~LOCATION 
94 1109 MULTIPLIERS : REF VECTOR, 
944 1110 BOUNDS : REF VECTOR, 
945 1111 LOW_INDEX, 


F 1 
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2885 10-388-1 382 71:88:26 BASRTL. REIBASVIRTUA.B82;1 - 5 


3 ae$ 116 HIGH INDEX, 

; 9% 111 INDEX_INCR 

: 948 1114 INDEX NUMBER, 

; 949 1115 VALUE_DESCR : BLOCK (12, BYTE], 

; 950 1139 VALUE DESC_ADDR, 

; 951 111 LENGTA; 

; 928 1118 

; 1119 + 

> 954 1120 : Be sure the number of array subscripts matches the number of 

s D9 1121 ! indicies given to us. 

>; 956 11 ¢ le 

s Yor 11 

; 958 1124 IF (CACTUALCOUNT () = 4) NEQU .DESCRIP COSC$B_DIMCTI) 

; 959 1125 THEN 

; 960 1126 BEGIN 

; 961 1127 

; Re 1 : $ IF (CACTUALCOUNT () = 4) LSSU .DESCRIP CDOSCS$B_DIMCTJ) 

; +¢: 1186 BASSSSTOP (BASS$K_TOOFEWARG) 

; 966 1136 BASSS$STOP (BAS$K_TOOMANARG) ; 

; 967 113 

; 968 1134 § END; 

> 969 1135 

: 970 1136 § '¢ : 

: 971 1137 ! The coefficients and bounds must be present. 

: 978 1139 5 

$ ore arate § IF ( NOT (.DESCRIP CDSCSV_FL_COEFF] AND .DESCRIP CDSC$V_FL_BOUNDS])) THEN BAS$$STOP (BASS$K_ARGDONMAT); 
; 976 ee § MULTIPLIERS = DESCRIP CDSC$L_M1]; 

3 444 he $ BOUNDS = DESCRIP CDSC$L_M1] * (ZUPVAL*®.DESCRIP CDSC$B_DIMCT)); 
ea 7° 

: 979 1145 2 ! Compute the lower and upper index numbers based on how the array 
; 980 1146 2! is stored. 

; «981 1147 2 !- 

; 982 1148 § 

> 983 1149 IF (.DESCRIP COSC$V_FL_COLUMN)) 

; 4984 1150 THEN 

; 985 1151 BEGIN 

; 986 1136 OW _ INDEX = .DESCRIP COSC$B_DIMCTI; 

: 987 115 HIGR_INDEX = 1; 

: 988 1154 INDER_INCR = =1; 

; TP 1155 END 

; 990 1156 ELSE 

; 991 1157 BEGIN 

; PP 1158 LOW INDEX = 1; 

; 1159 HIGA_INDEX = .DESCRIP CDSC$B_DIMCT); 

3: 994 1160 INDER_INCR = 1; 

; 995 1161 END; 

; 9% HB 

$ pad By ,, INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

a -* 

: .999 1165 ! If this is a decimal array, the length in the descriptor is the number of 
; H+ By } a gtat oterts (not including the sign). Convert this length to the number 
3 !o es. 

3: 1002 1168 ‘ hise. if this is a virtual array, the size must be a multiple of 2. This 
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1 Bliss-32 v4.0-74 Page 30 
10-Sep-1984 11: BNSRTL SREIBASVIRIOA-6823 1 oe 2 


S 
Ww 
nn 


is true for arrays of records as well. 


004 
84 CASE ,EStRIP COSC$B_DTYPE] FROM DSCSK_DTYPE_Z TO DSCSK_DTYPE_H OF 
00 
00 COSCSK_DTYPE_P) : ! decimal 
00 BEGIN 
LENGTH = Patti | COSCS$W_LENGTH]/2) + 1; 
Ie saaaseal DSC$B_CLASSJ-EQL DSC$K_CLASS_BFA 
BEGIN 
LENGTH = ( INCR 1 FROM 1 TO 9 BY 1 DO 
IF .LENGTH LSS (1% .I) 
THEN EXITLOOP (1 * .I) ); 
END; 
END; 
CDOSCSK_DTYPE_Z]) : ! record 
BEGIN 


LENGTH = .DESCRIP COSC$W_LENGTH); 
IF_.DESCRIP CDSC$B_CLASS] EQL DSC$K_CLASS_BFA 


N 
BEGIN 
LENGTH = ( INCR 


WN —OOONOVUES WN “OVD ONOUEWN—-OO0O~n 


WWI AIA RIPPIN PINPIPONURD 4 9 I SS 
MEWN $0 OOO NEW 9 OONOU EWR" O OONOUES WN O00 


em em nw nf nla lololololololololololelelololololololelolo] 
SSS SSF SC SS See Re La SR ees sae SSS 


ee ea me ee ee ee a a a a ed a od 8d ot od 


ka a aa ak a a a at a = = St = 2 2 SS SS SS SYS SS I YH YY SY 


POPGROPOPEPOPOPOPONONONIPUNPIPOPININININPINININININIDS 4 9 9 OO OO OS SS SO 


; END; 
5 


34 CINRANGE, OUTRANGE) : 
35 LENGTH = .DESCRIP COSC$W_LENGTH); 
36 TES; 
37 
38 '¢ 
44 Compute the Linear index from the indices provided. 
041 ; VALUE_LOCATION = 0; 
ac8 09 WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
045 1 INDEX_VALUE = ACTUALPARAMETER (.INDEX_NUMBER + 4); 
029 ig IF ((. INDEX_VALUE LSS .BOUNDS (C(.INDEX_NUMBER - 1)*2]) ! 
eee \ .. (. INBDEX_VALUE GTR .BOUNDS ((, INDEX_NUMBER - 1)*#2) + 1))) 
Bao 1g BASSSSTOP (BASS$K_SUBOUTRAN) ; 
434 H AE LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
054 0 : 
036 VALUE_LOCATION = (.VALUE_LOCATION®.LENGTH) + .DESCRIP CDSC$A_A0]; 
05 Med 
058 f ' add the offset to the linear index to arrive at the desired element within 
059 5 ' the record. 
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SNS SINGS 
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S3a~ 
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SEZESESSSESE 


FEES SS 


SSLESFALLS 
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SSN ND PAA AA AA AA MAI BB BBE BE BE PAWN IIOoponoenp 
FUR AO OONO VE WD $0 ODNAVNE WN $$ O ODNAN EWN SOOO NA UE WN OO OONO 
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'¢ 


i Build a descriptor pointing to the value cell in the array. 


H 1 
1enSep-198e 81:56:66 


VALUE_LOCATION = .VALUE_LOCATION + .OFFSET; 


AX-11 
BASRTL 


If this 


! is an array of descriptors, the descriptor is copied, otherwise it 
is constructed. 


1 


— COSCSB_DTYPE] EQLU DSCS$K_DTYPE_DSC) 
BEGIN 


Pp 
VALUE _LOCATION : REF BLOCK (8, BYTE]; 


VALUE_DESCR CDSC$W_LENGTH) = 
VALUE-DESCR CDSCS$B-DTYPE] = 
VALUE ~DESCR : 

e A_POINTER] = .0 
VALUE-DESC_ADDR = <VALUE LOCATION; 
SCR CDSC$B_DTYPE] EQL DSCSK_DTYPE_P 


IF .VALUE_BESCR 
THEN 
BEGIN 
MA 
VALUE_LOCATION : 


mo 


REF BLOCK (12,BYTE] 


VALUE_LOCATION CDSC$W_LENGTH); 
ALUE_COCATION COSC$B_BTYPE]; 
4 (. VAL E LOCATION CBSC$B_CLASS] EQLU DSC$K_CLASS_D) THEN DSC$K_CLASS_ 


CLAS 
ALUE_LOCATION CDSCSA_POINTER); 


VALUE_DESTR CDSC$B_SCALE) = .VALUE._LOCATION CDSC$B_SCALE); 


END 
N 
VALUE_DESCR CDSCS$W_LENGTH] = (IF .VALUE fos¢$B_ TYPE] EQL DSC$K 
-VALUE CDSC$B-DTYPE) EQL DSCSK 
THEN .STR_LENGTH 
ELSE .VALOE COSCS$W_LENGTH)); 
VALUE_DESCR DSC$B_DTYPE] = .VALUE CDSCSB_DTYPEJ: 
VALUE-DESCR CDSC$B_CLASS] = DSCS$K_CLASS_S; 
VALUE~DESCR CDSCSA~POINTER] = .VACUE_LOCATION; 
VALUE-DESC_ADDR = VALUE_DESCR; 
CDSC$B_BTYPE] EQL DSC$K_DTYPE_P 


IF VALUE _BESCR 
THEN 
BEGIN 
MAP 
: REF BLOCK 


DESCRIP : eect tt 
Ae vee COSC$B_SCALEJ = 


.DESCRIP CDSC$B_SCALE); 


i Make sure that the data type of the array element agrees with 
that of the source descriptor. 


IF (.VALUE_DESCR CDSC$B_DTYPE] NEQU .VALUE CDSC$B_DTYPEJ) THEN BASSSSTOP (BASS$K_DATTYPERR); 


at Yetta as 
CJBASVIRTUA.B32;1 


re 


Be Be Se Se Se Be Se Se Be Se Be Oe Be Se Ge Se Se Be Se Ge Fe Be Se Se Se Se Se Ge Se Ge Se Se Se Se Se Se oe SH Ss Se Se Se Se Se Se Se Se Ge Se Se Se Ss Se SCHSe Ss os 


a a a 


1 ~ haere ee 1b-sep-1984 91: 9:44 AX-1 iss- 


1 Bliss-32 V4.0-74 Pa | 
14-Sep- 3:6 EBASRTL SREIBASVYRTOA. B82: 1 of 


‘ f } Special handling if this is a virtual array. 

¢ : 
$ enamel COSC$B_CLASS] EQLU DSCSK_CLASS_BFA) 
¢ bs BEGIN 
4 90 LOCAL 
? 4 . SAVE _LENGTH; 
7 38 i KLUDGE!!! op up the array length descriptor to contain | 
8 94 $ the Length of the element in the record we are 
; 3 } interested in. 
1 9 SAVE_LENGTH = .DESCRIP CDSC$W_LENGTH); | 
¢ DESCRIP Cbd 
4 


a 


SCSW_LENGTH] = ( IF DESCRIP COSCSB_DTYPE] EQL DSCSK_DTYPE_P 
THEN .VALUE_DESCR CDSC$W_LENGTH] / 2 + 


COUNT 
TEMP_DESC : BLOCK (8, BYTE); 


90 ELSE .VALUE-DESCR CDSC$W-LENGTHJ ); 
4 IF (.DESCRIP COSC$B_DTYPE] EQLU DSCSK_DTYPE_DSC) THEN BASS$$STOP (BAS$K_NOTIMP); 
04 ‘+ 
5 ! If this is a string, we must pad it with SPACES. To do this, we need | 
0¢ : @ temporary string. 
ee ey 
9 IF (.VALUE_DESCR fDSC$B_DTYPE] EQL DSCS$K_DTYPE_T) 

? ee DSC$B_DTYPE] EQL DSCSK_DTYPE_2) 
¢ BEGIN 

4 OCAL 
5 SPACES 

6 

7 

8 

9 

0 


EMP_DE GTH] = 0; | 
TEMP-DESC CDSC$B~DTYPE] = DSCSK_DTYPE_T; | 
TEMP~DESC CDSC$B-CLASS] = DSCSK~CLASS~D; 


ER] = 
a STRSCOPY_DX (TEMP_DESC, .VALUE); | 
Concatenate enough SPACES onto the string to make it the right length. 
: SPACES_COUNT = .VALUE_DESCR CDSC$W_LENGTH) - .TEMP_DESC CDOSC$W_LENGTH); 


CONOVES UN “OO OONO VE WN OOO 


SO OEE EEE CR te ee pe NE FE FT 


WALA AAO ROMOROPORUNONUNIDD — OOOO 
WN —OOOBNOUEWN— 


wn 


ek a a mk a km tk tk ek et wed a ik a et ot = ow 
ee a ee ec dd 2d = ow 
OPO O OC Oe ne Se SQN a= 

w w 
am a na a ka a a a a a a a a a = ss = a — as = © os 4 td 2s a + 1) 2 2 ss a 


IF (.SPACES_COUNT GTR 0) | 
THEN | 
BEGIN 

68 

$9 5 LOCAL 

70 SPACES_DESC : BLOCK (8, BYTE); 

re 8 SPACES_DESC [DSC$W_LENGTH) = 1; 

7 9 SPACES-DESC CDSC$B~DTYPE) = DSC$K_DTYPE_T; 


a ee tee 


‘4 | 
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tt 127800- 1382 iF 6:46 BASRTL.SRC BASVIRTUA. B92; 1 . RS 
1174 SPACES_DESC oSCSB_cL Ass] = DSCSK_CLASS_D; 

SPACES-DESC CDSCS$A-POINTER) = 

STRSDUPL CHAR (SPACES.DESC, SREF (.SPACES COUNT) , GREF (%X°20")); 

STRSCONCAT (TEMP_DESC, TEMP_DESC, SPACES_DESC) 

STRSFREE1 DX (SPACES_BESC); 


4 


; Now store the (possibly lengthened) string in the file. 
“ BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, .TEMP_DESC CDSCSA_POINTER)); 
; Free our temporary string. 
STRSFREE1_DX (TEMP_DESC); 
ELSE 


BEG! 
> BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, .VALUE CDSC$A_POINTER]) 


CoO8 C908 INI 
Wr —O0DOnoul 


'¢ 

i put Length field in array Syeeriptor back the way 
: _it was before we KLUDGED it 

DEscRIP CDOSCS$W_LENGTH] = .SAVE_LENGTH; 


ELSE 
BEGIN 


BVISSSLESSRAVLESELSERE 


PDE DIDI DIDI IIIA tc td td dt td 
CO O8 SIN NN SN SSFP AAA AA AAA MMIII ES SPE P ELE EE 


\ te +4 
CNOA WEP CO OOO NO UE WIN 3 © OCONOA UNE WI (OOONS VFA OVO ONOUE WO 


A. ALAA AAAI AINA ANIA AAA NANA AAAI AAAI NIAAA AANA 


ee ee ee a a ee ee ed ed od = od dd od od 


PPA AA AHLAA. AAA AAAN AMAA NAAN AIAN AAAI ANIA BS PAE BPE PPPS PN 


Oe Be Oe Oe Be Se Be Oe Se Oe Oe Be BH Se Be Se Se Se Ge Se Se Be Ge FH Se Ge SH Ge Se Be Se Se Se Ge Se Se Oe wy Oe Se Os Se OH Se Oe Se OH Ss OHS Oe Oe Se ee Se eee 


a et ee a et at a a td = ot = a 2 


pe IF (. DESCRIP CDSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$$STOP (BASS$K_NOTIMP) ; 
06 'e 
07 i i base the value cell to the array element. The form of the copy is 
4 : _based on the type of data. 
10 
iH sted”: tenes CDSCSB_DTYPE] FROM DSCS$K_DTYPE_Z TO DSCSK_DTYPE_H OF 
1 
14 CDSCS$K_DTYPE_B) : ! byte 
15 BLOCK C C. VALUE DESCR COSCSA_POI NIER . 0, 0, ZBPUNIT, 1] 
i = .BLOCK C.VACUE CDSC$A POINTE 1, 0. 0; %6PUNIT, 14; 
18 COSCSK_DTYPE_W ! 16-bit w 
19 8 BLOCK C EheuE th COSC$A_POIN TERI. 6° oe 0” OF SPVAL/2 
$31 8 a BLOCK t C.VACUE COSC$A_POINTER], 0. 0. XOPVAL/2, 4," 
§ 4 8 COSCSK_DTYPE_L ! 32-bit otongeore 
$ 89 BLOCK C Fhe ue peste COSCSA_POI NIER . 8° 8 } 
4 90 “bLotk t C.VACUE COSCSA “POINTE J, 0, 0, SSPVA AL, Ay 
$ 9 COSCSK_DTYPE_F) : ! 32- ag! t VALUE DE poin 
4, BASSSCOPY_ F _RI (,VALUE COSC$A _POINTER -VALUE_DESCR CDSCSA. POINTER)); 
3 95 COSCSK_DTYPE_D) : ! 64-bit double floatin ng 
0 96 - BASSSCOPY DL R1 (. VALUE COSCSA _POINTER + »VALUE_DESCR CDSCSA_POINTER]); 


es 4 | 
ASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 34 
pasty . 12-808718 4 OF ei26 BNSRIL’ SREIBASVIRTUA. B92; ° ay 
; 1231 1 97 
1 ; 1 8 CDSC$K_DTYPE GJ : 1G floating 
1399 BAS$SCOPY_G_R1 (.VALUE CDSCSA_POINTERJ, .VALUE_DESCR CDSCSA_POINTER)); 
1235 1401 CDSC$K_DTYPE_H) : ‘4H floating 
! 1408 BASSSCOPY_H_R3 (.VALUE CDSCSA_POINTERJ, .VALUE_DESCR CDSCS$A_POINTER); 
1238 1404 CDOSCSK_DTYPE_T, DSCSK_DTYPE 2] : ! Text string or record 
! i 1609 STRSCOPY_DX (.VALOE_DESC_ADDR, .VALUE); 
1241 1209 CDSCSK_DTYPE_P) : ! decimal 
124 1408 4 BEGIN 
124 1409 4 P | 
1244 1410 4 VALUE : REF BLOCK £12,BYTE); | 
1245 1411 4 LOCAL 
1246 141g 4 OUNT; 
1247 1413 4 COUNT = .VALUE CDSC$B_SCALE] - .VALUE_DESCR CDSC$B_SCALE); | 
1248 1414 & ASHP (COUNT, VALUE COSC$W_LENGTH] VALUE COSCS$A_POINTERJ, 
49 1615 4 UREF(O); VALUE_DESCR CDSC$W_LENGTHJ, .VALUE_DESCR CDSCSA_POINTER)); 
1251 1417 
1 3¢ 1418 CINRANGE, OUTRANGE] : | 
125 1419 BASS$STOP (BASSK_DATIYPERR) ; | 
1254 1420 
1255 1421 TES; 
1256 Pe 
1257 14 END; 
1258 1424 
1259 1425 1 END; ! end of BASSSTORE_BFA_OFF | 
| 
| 
OFFC 00000 -ENTRY BASSSTORE_BFA_OFF, Save R2,R3,R4,R5,R6,R7,- ; 1055. 
R8,RO,RI0O-R11 ; 
5E 24 C2 00002 SUBL2 #36, SP : 
50 6C 9A 00005 MOVZBL (APS, RO 3 1126 | 
50 04 C3 0008 SUBL2 #4, RO : 
56 08 AC DO 0000B MOVL DESCRIP, R6 : 
52 0B A6 9A O000F MOVZBL 11(R6), R2 ; 
52 50 D1 00013 CMPL ; : | 
1c 13 00016 BEQL ; | 
50 6C 9A 0018 MOVZBL (AP), RO : 1128 
04 C2 001B SUBL2. #4, RO ; | 
52 50 D1 OOO1E CMP RO, R2 F | 
6 1€ 00021 BGEQU : 
7E 006 f 9A 09 : MOVZBL #BASSK_ TOOF EWARG, -(SP) : 1130) 
7E 00G 8F 9A $8 9 1$: MOVZBL M#BASSK_TOOMANARG, -(SP) + 1132. 
000000006 00 1 FB 09 D 3: CALLS #1, BASS$STOP F | 
05 OA Ab 6 f 4 3$: BBC #6 10(R6), 4$ : 1140. 
OA Ab 3 0039 TSTB —_: 10 (RO) : 
0B 1 09 C BLSS : 
000000006 Of 06 OT eB 0045 se TALES AL BASSSSTOP, 
3 16 A6 9E 00049 5$: = MOVAB. «=. 20(R6), MULTIPLIERS > 1142, 
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BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 36 
pasty . 1 ~8ep-19 4 te 6:46 BASRTL. neioagvintoa-e82:1 ° (3 
18 1 ES BNEQ 17% : 
1 1 p E MOVL #1, + 1195. 
53 1 1 EA 13$ ASHL I, #1, R3 : 
3 4 D1 O00E CMPL LENGTH, R3 : 
3 18 F BGEO 5 : | 
54 p F3 14$ MOVL R3 LENGTH + 1196) 
0? 11 re BRB 17$ : | 
EE 1 9 £3 OOOF8 15$ AOBLEQ #9, I, 1 + 1195) 
4 1 CE O00FC 168 MNEGL #1. LENGT + 1194 | 
3 04 OOOFF 178:  CLRL_ + VALUE_LOCATION + 1207 | 
58 9 A Ci 00101 ADDL3 INDEXTINCR, HIGH INDEX, R11 + 1209 | 
A C6 1 3 18$:  ADDL2 INDEXTINCR, INDER_NUMBER : 
8 2 D1 001 CMPL JNDEX NUMBER, R11 : 
ec 13 00108 BEQL 1$ : | 
59 10 AC4 06 0100 MOVL § 16(AP)CINDEX NUMBER], INDEX_VALUE : 1211, 
50 58 01 0112 ASHL #1, INDEX NUMBER, R + 1213) 
FB ATG 3 D4 a0 18 CPL INDEX_VALOE. -8 (BOUNDS) CROJ ; 
FC A740 44 D1 sts CMPL JNDEX._VALUE , -4 (BOUNDS) (ROI + 1214) 
0B 15 001 2 BLEQ 0$ ; 
waar 7E 006 ar 9A or 4 19$: MOV ZBL WBASSK SUBOUTRAN, -(SP) + 1216. 
0 98 FC A542 8 $01 F 20$: MULL “A iMULTIPLIERS) CINDEX NUMBER] , - + 1218. 
53 50 59 C1 00135 ADDL3 INDEX VALUE, RO, VALUE_LOCATION : 
CA 11 00139 BRB 18$ + 1209 
5 53 54 C5 01 B 21$ MULL3. LENGTH, VALUE_LOCATION, RO + 1221 
4 20 10 Aad C1 0013F ADDL3 16(R6). RO, VALUE LOCATION ; 
5 OC aC CO 00144 ADDL2 OFFSET, VALUE_LOCATION ; 1227 
1B 02 a6 91 00148 CMPB (R6), #24 t 1235 
31 12 0014C BNEQ 4$ ; 
18 AE 63 BO 0014 MOVW  (VALUE_LOCATION), VALUE_DESCR ; 1242 
1A AE 02 A390 0015 MOVB (VALUE LOCATIONS , VALUE_DESCR+2 > 124 
02 03 Ad 91 0019 CMPB (VALUE“LOCATION). #2 + 1244 
05 if 0158 BNEQ  22$ ; 
50 01 oO 00190 MOVL #1, RO F 
04 11 00160 BRB @3f ; 
50 03 A3 9A 00162 328: MOVZBL 3(VALUE_LOCATION), RO > 124 
1B OAE 50 90 00166 23$: OVB RO, VALOE DESCR+3 > 124 
1C AE 04 A3 DO OO16A MOVL  4(VALUE LOCATION), VALUE_DESCR+4 $ 124 
54 53 DO O16 MOVL  VALUE_LOCATION, VALUE_DESC_ADDR > 124 
15 1A AE 1 172 CMB VALUE -DESCR®2, #21 i 124 
20 AE 08 a3 2 0178 MOVB (VALUE_LOCATION), VALUE_DESCR+8 : 125 
38 11 0017D BRB 8$ ; 123 
50 04 AC DO OO17F 248 MOVL ALUE, RO > 125 
0€ 02 Ag 1 3 CPE (RO), #14 
02 AO $e 189 TSTB (RO) : 1259. 
06 ff 18C BNEQ 6$ F 
51 10 aC pg 3 25$ MOVL STR_LENGTH, RI ; 1260 
51 60 3¢ 194 368 MOVZWL (RO), R1 : 1 $1 
18 AE 80 197 27$ MOV R1, VALUE_DESCR : 1258 
1A AE 02 AO 198 MOVB 2(RO), VACUE DESCR+2 : 1 6 
1B AE 1 90 OO1A MOVB #1, VALUE DESCR+ 3 1263 | 
1C AE 3 pO 001A4 MOVL  VALUE_LOCATION, VALUE_DESCR+4 3 1264 | 


BASSYIRTUAS _ARR 


20 
02 


000000006 
BF 


000000006 


10 


000000006 


08 
04 
04 


000000006 


000000006 
000000006 


000000006 


N 
16- 
14- 
18 AE 1A8 
TA hy: 1A 
0 18 
08 AB Y 1B 
04 AC 3 1B7 288: 
1A AE } 1B 
Be 1¢ 
00G 8F 9A OOIC 
1 fo 1€6 
03 AB YD 1CD 29%: 
0 } 1D 
006 1 0010 
8 0 107 30$: 
02 8 . Hey 
50 0D 1DE 
0B 12 OO1E1 
18 ag 3¢ Ries 
9 C6 OO1E 
0 06 SpieA 
04 #11 1EC 
18 AE 3C OO1E a3 
50 B60 dt 2$: 
02 Abd 91 OO1F 
0B 12 tte 
00G 8F 9A O001FB 
01 §£B Boone 
1A AE 91 00206 338: 
05 13 0020A 
1A AE 95 0020C 
7B 12 0020F 
020E0000 8F DO 00211 34$: 
14 AE 04 66 19 
52 DD O0021C 
14 AE 99F OO2ZIE 
02 FB oes) 
18 AE HS 0228 
10 AE 022C 
a. 82 9 
D 15 00 
02060001 8F 00 00235 
0c AE D4 00230 
2 BO 0240 
04 AE F 00244 
50 po 8 47 
04 AE F 4B 
10 AE 99F 0024E 
03 FB 00251 
08 AE 9F $ 58 
14 AE OF 5B 
18 AE OF 5 
035 FB 6 
08 AE OF 68 
01 FB 8 
14 ag DD 358: 
at 
03 FB 00279 


“520-198 91: 9:44 AX-11 Bliss-32 V4.0-7 


6:46 BASRTL.SRCIJBASVIRTUA. 4 2;1 


VALUE _DESCR, VAL tue DESC_ADDR 
a5 “DESCR#2, 


(R6), VALUE_DESCR+8 
VALUE, 

ALUE_DESCR+2, 2(R2) 
#BASSK DATTYPERR, (SP) 
#1, BASS $I 

(R6), #191 

0$ 

Bs 
R8, SAVE_LENGTH 
2(R6), RO 
RO, wet 
VALUE_DESCR, RO 
#2, RO 


32$ 

VALUE_DESCR, RO 

0, (R6) 

gih6), #24 

WBASSK NOTIMP, =(SP) 


#1, BASS$S 
ALUE *DESCR*?, #14 


ALUE _DESCR+2 


i 4471936, , TEMP_DESC 
TEMP_DESC+4 


al DESC 
#2, STRSCOPY_DXx 
VALUE DESCR,~SPACES_COUNT 
P_BESC a 
Re * sPAcEs_¢ 


71937 SPACES _DESC 
S DESC+ 
TSP) 


COUNT, 4(SP) 


“rcCwm 
ovo 


PL_CHAR 


~SOSTSSasaNsre y 
tam soe’ ms nn & 


PAATAHAYNYN TO RO = 
<anenn  aeen 


TEMP 
VALUE _ LOCATION 


i, BASS$SVA_STORE 


Page a 


Pe Se Se Se Se Se Se Se Se Se Se Ge Se Ge Ge Se Se Ge Ge Ge Ge Ge Ge Ge Ge Ge Ge Se Se Se Se Se Se Ge Se Ge Se Se Se Be Se Be Ge Ge Se Se Ge Ge Se Se Ge Se Be Se Ge Be Be 


1265, 
1266, 


1271, 
80. 


1344. 
1350. 


——--- - - - 


2 
| BASSVIRTUAL_ARR 1e-se =1984 01:29: 
Ling 1-8ep-19 4 a 
10 AE OF PUSHAB 
000000006 00 4 a] 6 50 CALLS 
11 8A RB 
04 A DD 0028C 36$: SHL 
5 DD 8 8F PUSHL 
38 DD 91 PUSHL 
00000000G 00 9 FB 8 93 CALLS 
66 5 B60 8 9A 378: MOVW 
04 9D RET 
04 03 Ab 4 0 3 38$: CMPB 
re es 
00000000G 00 Bt FB 88 A8& CALLS 
1c 00 02 A2 &8F OO2ZAF 39S: CASEB 
OO3A 003A 003A 0094 00284 40$: ~ WORD 
004C 0046 003A OO3A bose 
0067 0058 003A 0052 002C4 
OO3A 0094 003A 003A 002CC 
003A 003A 003A OO3A Bosee 
3é. 003A OOA0 OO3A 002DC 
0076 003A OO3A 003A 002E4 
0085 002EC 
7E 006 or 9A po ces 418: MOVZBL 
00000000G 00 1 FB OO2F CALLS 
04 002F9 RET 
1¢ BE 04 B2 90 OO2FA 42$ MOVB 
04 OO2FF RET 
1C BE 04 B2 0 88 00 43$ MOVW 
4 05 RET 
1C BE 04 B2 DO 00306 44$ MOVL 
04 00308 RET 
51 1¢ AE DO 00 0c 45$ MOVL 
50 gs A p0 3 1 MOVL 
00000000G 00 16 14 JSB 
04 OO3SIA RET 
51 1¢ AE 00 00518 46% MOVL 


1 Blis 
TL. 


E_LOCATION 


#3, BASSSVA_STORE 
SAVE_LENGTH, (R6) 


(R6), #4 
tee NOTIMP, =(SP) 


f 

ocm F 
nf wv 
_ 


ses 8s Se 8S 8S Se 8eUcSHhmUCMhMrhUChrhUCOrhCUCMCUCUCMTCUCMhFHhUCUCEmhUCMFhCUChTMUcL TMU HM hU[}hhUh Hh FB 


ASSK_DATTYPERR, -(SP) 
, BASSSSTOP 


@4(R2), @VALUE_DESCR+4 
@4(R2), @VALUE_DESCR+4 
B4R2), @VALUE_DESCR+4 
VALUE DESCR#4, RI 
BASSSCOPY_F_R1 

VALUE _DESCR+4, R1 


-32 V4.0 
SRC IBASVIRT 


Pe Se Se Se Se Se Se Se Se Se Se Se Ge Se Se Ge Se Se Se Se Se Se Ge Se Se Se Se Se Be Ge Be Be Be Be Be Se Se Be Se Se Ge Se Fe Fe Ge Se Se Se Fe Se Fe Se Be Se Se Fe Se 


1419 


1382 
1386 
1390 
1393 


13% 


——__- - --—-_- ———— —_ a ee ne ee ee 


| 


2 
BASSVIRTUAL_ARR 1h-s6 =1984 01:29:44 AX-11 Bliss-32 V4.0-74 P 9 
10038 1o-8ep-1986 11:56:46 EBASRTLOSRESBASVIRTUA.B32;1 eat 
0 4 A2 00 0031F MOVL  4(R2), RO | ; 
| o000000es 06 16 003¢8 38 BASSSCOPY_D_R1 : 
| 1 1¢ =AE DO 6 A47$: — MOVL VALUE _DESCR+4, R1 + 1399 
| 0 04 Ad 00 00 MOVL  4(R2)> RO : 
000000006 0 i6 0 38 BASS$SCOPY_G_R1 : 
51 1C AE DO 00339 48s: MOVL VALUE DESCR#4, R1 t 1402 
0 04 A2 00 0033p MOVL  4(R2)7 RO : 
000000006 00 16 00341 JSB BAS$SCOPY_H_R3 : 
04 00347 RET F 
52 DD 00348 49$:  PUSHL -R2 + 1405 
4 DD O034A PUSHL VALUE_DESC_ADDR ; 
000000006 00 02 FB 0346 CALLS #2, STRSCOPY_Dx : 
50 08 A2 98 00354 SOS: CVTBL 8 (R2), COUNT + 1413 
51 20 AE 98 00358 CVTBL VALUE. DESCR+8, R1 ; 
50 51 ce 0035¢ SUBL2 1, COUNT ; 
00 04 B2 62 50 F8 0035F ASHP COUNT, (R2), @4(R2), #0, VALUE_DESCR, - : 1415 
1C «BE 18 AE 00365 VALUE _DESCR+4 F 
04 00369 RET : 1425 
; Routine Size: 874 bytes, Routine Base: _BASSCODE + 0645 


; 1260 1426 1 


dD 2 
6-$ 


PASS TRTUAL fae 1 00m 1386 91: 9:44 ret Bliss-32 rhe Page 40 
1-03 14-Sep-1984 11:56:46 BASRTL.SRCJBASVIRTUA.B32;1 (6) 
; 126 1427 1 GLOBAL ROUTINE BASSSTO_FA_RDX ( ! Store a string by reference 
; 126 1428 1 VALUE _L ' Length of value 

> 1264 1409 1 VALUE ADDR, i Address of value 

> 1265 1430 1 DESCRIP, ' The descriptor to store it 
3 1 ¢ 1431 1 INDEX, ' First index 

; 126 14 ¢ 1 INDEX2 ! Optional second index 
3: 1268 14 1 ) : NOVALUE = 

3: 1269 1434 1 

3; 1270 1435 1 !44 

; } a 7? $ : FUNCTIONAL DESCRIPTION: 

: 1378 1438 1! Store a string in an array or virtual erry. The erring is 

> 1274 1439 1! passed by reference. The compiler uses this entry poin 

$ \s?? Pe : to avoid creating a descriptor for a string constant. 

3 1277 aug 1 ' FORMAL PARAMETERS: 

; 1278 144 1! 

; 1279 1444 1! VALUE_LEN.rl.v The Length of the string to be stored 

; 1¢00 1445 1! VALUE ADDR.rt.r The address of the string to be stored 

3: 1281 1446 1! DESCRIP.rx.da The descriptor of the array or virtual array 

; 1c8¢ 1447 1! INDEX1.rl.v The first index into the array. 

3; 128 1448 1! INDEX2.rl.v The second index. This is optional. 

3; 1286 1449 1! 

; 1285 1450 1 ! IMPLICIT INPUTS: 

: 1286 1451 1! 

3: 1287 626 1! NONE 

: 1288 1453 1! 

3; 1289 1454 1 ! IMPLICIT OUTPUTS: 

: 1290 1455 1! 

3; 1291 1456 1! NONE 

3 1636 1457 1! 

: 129 1458 1 ! ROUTINE VALUE: 

3 1294 1459 1 ! COMPLETION CODES: 

3: 1295 1460 1! 

3; 1296 1461 1! NONE 

3 1297 1ec8 1: 

3; 1298 1465 1 ! SIDE EFFECTS: 

3: 1299 1464 1! 

; 1300 1465 1! Signals if an error is encountered. 

3; 1301 1466 1! 

3 1308 1467 1 !<- 

3; 130 1468 1 

3; 1304 1469 2 BEGIN 

3; 1305 1609 

3: 1306 147 BUILTIN 

3; 1307 sore ACTUALCOUNT; 

3; 1308 147 

3; 1309 1474 LOCAL J 

; 1319 1672 VALUE : BLOCK (8, BYTE); ! Build descriptor here 
3 1312 1497 VALUE CDSC$W_LENGTH] = .VALUE_LEN; 

3; 131 1478 VALUE CDSCS$B_DTYPE] = DSCSK_DTYPE_T; 

3 1314 1479 VALUE CDSC$B_CLASS) = DSCSK_CLASS_S; 

; a 1009 VALUE CDSCSA_POINTER] = .VACUE_ADDR; 

3 1317 ieee IF (ACTUALCOUNT () LSS 5) 

; 1318 1485 2 THEN 


BASSVIRTUAL_ARR 


; 1319 


; 3 
3 3 
| 
3 3 
3 3 


Wwnr—o 


4 


; Routine Size: 54 bytes, 


; 1325 1490 1 


2 
1$-sep-19 4 01:29:44 ree Bliss-32 V4.0-74 
BASRTL.SRC JBASVIRTUA.B 


14-Sep-1984 11:56:46 
BASSSTORE_BFA (VALUE, .DESCRIP, .INDEX1) 


BASSSTORE_BFA (VALUE 
-DESCRIP, .INDEX1, .INDEX2); 


END; ! end of BASSSTO_FA_RDX 
000 90009 .ENTRY BASS$STO_FA_RDX, Save nothing 
5E 08 C2 000 - SUBL2 #8, 
6E AC 80 0000 MOVW VALUE LEN. VALUE 
02 AE 010E  8F BO 00009 MOVW #270, VALUE+ 
AE AC DO 0000F MOVL  VALUE_ADDR, VALUE+4 
05 6C 91 00014 CMPB Ss CAP) , “#5 
OD 1€ 90017 BGEQU 
7E 0c AC 7D 00019 OVQ DESCRIP, -(SP) 
08 AE OF 90010 PUSHAB  V 
FOSE CF 0 FB 90020 CALLS #3, BASSSTORE_BFA 
7E 10 AC 90036 1$: MOVQ = INDEX1, =(SP) 
OC AC DD OO02A PUSHL DESCRIP 
OC AE 9F 00020 PUSHAB VALUE 
FOZE CF 04 FB 00030 CALLS #4, BASSSTORE_BFA 
04 00035 RET 


Routine Base: _BASSCODE + O9AF 


Page 41 
. (6) 


BASSYTRTUAL ARR 16-Sep-1984 91:99:46 AX=1 


Bliss-32 v4.0-7 Page 42 
1e-8ep-1984 11 RCIBAS v5 


1 4 
6:46 BASRTL. viniua.B$2;1 . (7 


: 1327 1491 1 GLOBAL ROUTINE BASSFET_FA u_Be ( ! Fetch a word 
3; 1328 1438 1 PescniP : REF BLOCK"C8, BYTE], ! The descriptor to fetch from 
; 1329 14935 1 INDEX1, ' First index 
3; 1330 1494 1 INDEX2 ! Second index 
: 1331 1495 1 ) : VA_JSB = 

3; 3 ¢ 1638 1 

: 1 1497 1 !44 

: : ¢ 1098 : FUNCTIONAL DESCRIPTION: 

3 ’ 33 1280 : } Fetch a 16-bit word from an array or virtual array. 

: Hs 130¢ ! FORMAL PARAMETERS: 

3; 1340 1506 1! DESCRIP.rw.da The descriptor of the array or virtual array 
3: 1341 1505 1! INDEX1.rl.v The first index into the array 

3 1348 1306 } INDEX2.rl.v The second index into the array 

3 1344 1508 1 ! IMPLICIT INPUTS: 

3 lee? 1509 1! 

3 1346 1510 1! NONE 

3 1347 311 3? 

3: 1348 1316 1 ! IMPLICIT NUTPUTS: 

: 1349 15135 1! 

3; 1350 1514 1! NONE 

3; 1351 1515 1! 

: 1328 1516 1 ! ROUTINE VALUE: 

s 155 1517 1 ! COMPLETION CODES: 

: 1354 1518 1! 

3; 1355 1519 1! The word from the array or virtual array 

3; 1356 1520 1! 

3 1357 135! 1 ! SIDE EFFECTS: 

3; 1358 15 ¢ 1! 

3; 1359 lees Ff Signals if an error is encountered. 

3; 1360 1524 1! 

3 1361 1525 1 !<= 

1306 1526 1 

3: 136 1527 2 BEGIN 

3: 1364 1528 

3; 1365 1367 LOCA 

3 1366 1530 BOUNDS : REF VECTOR 

> 1367 1531 MULTIPLIERS : REF VECTOR, 

3; 1368 1336 LOW_INDEX, 

3 1369 153 HIGR_INDEX, 

: 1379 1eee INDER_INCR 

> 1371 1535 VALUE ~LOCATION, 

: 1376 1336 INDEX_ VALUE 

3; 137 153 INDEX NUMBER, 

3: 1374 1538 TEMP_DESCRIP: REF BLOCKC,BYTE); 

3; 1375 1539 : 

: 1376 1540 '¢ , 
; 10 1349 : Be sure the array has at least one but no more than two dimensions. 
: 1379 154 

: Ht 1368 IF ((. DESCRIP CDSC$B_DIMCT] LSSU 1) OR (.DESCRIP COSC$B_DIMCT] GTRU 2)) THEN BASS$S$STOP (BAS$K_ONEOR_TWO) - 
3 1 5 1366 ; '¢ ‘ 

; 138 154 ! Be sure this array or virtual array holds words. 


2 | 


ASSVIRTUAL_ARR 18-se0-1984 01:29:44 WAXeI1 Bliss=32 v4.0 


14-Sep-1 1:36:46 BASRTL.SRC BASVIRTUA. 7382; ;1 


—-@ 
ou 


3 


Page 43 an 
al, 


84 
5 
i. {. DESCRIP COSCSB_DTYPE] NEQU DSCSK_DTYPE_w) 
re mE c. DESCRIP COSCSB_DTYPE] EQLU DSCSK_DTYPE_DSC) 
90 Mie 
4! t Special handling for dynamically mapped arrays. 
38 BEGIN 


TEMP. DESCRIP = DESCRIP CDSCSA_POINTER]; 
IF ([TEMP_DESCRIP COSCSB_DTYPEJ NEQU DSCSK_DTYPE_w) 


BASS$STOP (BASS$K_ARGDONMAT) ; 
END 
ELSE 
BASSSSTOP (BASS$K_ARGDONMAT); 


i “the coefficients and bounds must be present 


SRLEARALLSSSLESER 


IF ( NOT (.DESCRIP CDSCS$V_FL_COEFF] AND .DESCRIP CDSC$V_FL_BOUNDS])) THEN BASS$$STOP (BAS$K_ARGDONMAT); 


MULTIPLIERS = DESCRIP CDSC$L_M1); 
BOUNDS = DESCRIP CDSCSL_M1) * (ZUPVAL*®.DESCRIP CDOSC$B_DIMCTJ); 


' 
i ¢ aged ag lower and upper index numbers based on how the array 
le 


Ne ‘ DESCRIP COSC$V_FL_COLUMN)) 


eg! THE = .DESCRIP CDSC$B_DIMCT); 
HIGA_I = 1; 
is NER = «|; 


OWOONAUE WN SO ODNAU EWN $0 ODNAUE WN OC OONOUS WN OOO 


PMOTOROTUNYD 2 2 
ONAOUS WO OONOUSWN oO 


Moron 


= 1; 
x = {DESCRIP COSC$B_DIMCT); 
INDER.INCR = 1; 


Cass 
UEwn— 


wh 


INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
i “Compute the Linear index from the indices provided. 
VALUE_LOCATION = 0; 
wines HY aad NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX * .INDEX_INCR)) DO 
FNDEX. VALUE = (IF (,.INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


tad ad aia atatadadadatadadtadatadbmadatadbadadadaiatatatadabad adabatad dadbabadad daiadadbabadabadbababadbadabadadadabad 


fo lal *al* alah Ab Ab Ab Ab Ab Ah Ah Ab Ab Ab Ab cb db db bb bb bb Ab edh sb sh sh ahah ahah al sbeal val val val wal ealealealesleslesle ieee ee ww ew) 


Fay ot at ot ot ot nt ot ot et ot at at tk ee ee ee he ke 


SSSVER 
eit} 


So 
= 


3; 1 
3 1 
4 
3: 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3 1 
3: 1 
3 1 
3 1 
2 
3: 1 
3 1 
Ss 
3 1 
3 1 
3 1 
3 1 
3 1 
: 1 
3 1 
2 3 
. | 
3: 1 
3 1 
: 1 
3 1 
3: 1 
3: 1 
3 1 
3 1 
21 
3 1 
3 1 
3 1 
: 1 
3 1 
3: 1 
3 1 
: 1 
3 1 
3: 1 
3 1 
| 


3 
f 
7 
i 
2 


iss-32 V4.0-74 Page 44 
SeSanevinton 8251 9) 


H 2 
ese se Uses 


€2:44 AX-1 


186 
6: BASRTL. 


nn 


4 1: 


_ 
= 
* 
— 


UMBER = 1)*2]) ! 


IF ((, INDEX VALUE LSS_ .BOUNDS bt. JWOes un NUMBER -"1)#2) * 19)) 


A (. INDEX_VALUE GTR .BOUNDS [((. 
BASSSSTOP (BASSK_SUBOUTRAN) ; 
ate = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER - 1]) + .INDEX_VALUE; 


VALUE_LOCATION = (.VALUE_LOCATION®. DESCRIP CDSCSW_LENGTH]) + .DESCRIP CDSC$A_A0]; 
AF eg PeocRsP DSCSB_DTYPEJ EQLU DSC$K_DTYPE_DSC 
1+ 


Special handling for dynamically mapped arrays. 


BEGIN 

TEMP_DESCRIP = .VALUE_LOCATION; 

VALUE_LOCATION = .TEMP_DESCRIP CDSCS$A_POINTERJ; 
END; 


PDEA & 


'¢ 
Special handling if this is a virtual array. 


WWW POPOPIPUPIPONINYDYD 2 2 OO OOOO 


DWONA WE WIN OOO NAUN EWN 0 ODNAUES WIN (OO OONIAUE WIN" OOONOU 


en Or COSC$B_CLASS) EQLU DSC$K_CLASS_BFA) 
BEGIN 
LOCAL 
VALUE ; 


VALUE = 0; 
BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, VALUE); 
pe rune T. VALUE); 


PAEAEXRXAAAAAAAAAAAA AAA AAA AAA AAA AAA AAA AAS 


6o00 0908 SI NNN NS NNN SIOOOOO 
SPOS SS Sas F ANS SSS SSF SSeS So sear 


IF (.DESCRIP CDSC$B_CLASS] NEQU DSCS$K_CLASS_A) THEN BASS$STOP (BASS$K_NOTIMP); 
'¢ 
Return the array element as our value. 


RETURN (.BLOCK C.VALUE_LOCATION, 0, 0, Z%BPVAL/2, 1]); 
END; ! end of BASSFET_FA_W_R8 


Seeee 


ee ee ee eee 
See 
Fe ad at tt ek et ee eth oh ab ad ad ad a 


Be ak ak ek tat ek eh eee al tata tal al al tal tal eal ed kk ek el ek Set ke eh ee eh ee 
i ee a a a kk ed dd dd a 
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1 0000 BASSFET_FA_W_RB:: 
“ red 2 “SUBL2 #16, SP ; 1491 
D 0008 PUSHL Ri 
8 


MOVL RO, RS 
, p MOVZBL 11(DESCRIP), R3 1544 
; C BEQL si 

O0E CMPB RS, #2 


wv 

Www 
Mmorum 
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BASSVIRTUAL_ARR ihesé =1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 45 
Assy betas 1 ti Yori BASRTL. neisagvintua-e82:1 9 75 
B 18 0001 BLEQU 2$ { 
7 006 i 9A 13 1$: MOVZBL M#BASS$K_ONEOR_TWO, -(SP) : 
000000006 a 1 & 1 CALLS A BASSSSTOP : 
02 A> ? i 2$: CAPE (DESCRIP), "7 + 1550. 
18 02 AS ? 4 cHPB g(DESCRIP), #24 : 1552. 
57 4 AS 06 A MOVL 4(DESCRIP) TEMP_DESCRIP + 1559. 
07 2 a7 91 0 E CPS ¢ (TEMP DESCRIP) 4 + 1560. 
7E 006 8F 9A 00034 3$ MOVZBL #BASS$K_ARGDONMAT, =(SP) + 1566 | 
000000006 09 1 Fe 8 CALLS. #1, BASS$STOP F 
05 OA A 6 f F 4$ BBC a6 O(DESCRIP), 5$ + 1573) 
OA AS 95 00044 TSTB  10(DESCRIP) ; | 
B 19 00047 BLSS 6$ : 
7E 006 8F 9A 00049 5$ MOVZBL #BASS$K_ARGDONMAT, =(SP) : 
000000006 09 1 FB 0004D CALLS. #1, BASS$STOP : 
08 AE 14 AS GE 00054 6$ MOVAB g0(R ) MULTIPLIERS + 1575) 
56 14 A543 DE 00059 MOVAL Q(DESCRIPIERS , BOUNDS : 1576) 
0c OA AS 05 €1 0055 BBC #5, 10(DESCRIP), 7$ : 1582) 
51 53 DO 0006 MOVL R3, LOW_INDEX > 1585 | 
50 07 00 00066 MOVL #1, HIGA_INDEX + 1586) 
04 AE 01 ce 90069 MNEGL #1, INDER_INCR + 1587) 
OA 006D BRB as > 1582 | 
51 01 00 O006F 7$ MOVL #1, LOW_INDEX : 1591) 
50 53 D Boor MOVL R3, HIGA_INDEX : 133¢| 
04 AE 01 DO 0007 MOVL #1, INDER_INCR : 1593) 
54 51 04 a C3 00079 8$ SUBL3. INDEX_INCR, LOW_INDEX, INDEX_NUMBER ; 1596. 
53 04 0007E CLRL_ VALUE~LOCATION + 1600. 
Oc AE 04 BE40 H 00080 MOV @INDER_INCRCHIGH_ INDEX), 12(SP) > 1602. 
54 04 AE CO 00086 9S: ADDL2 INDEX_INCR INDER NUMBER ; 
OC AE 54 D1 OO08A CMPL INDEXNUMBER, 12(SP) : 
3a 13 0008 BEQL 4$ ; | 
01 54 Di 0009 CMPL INDEX_NUMBER, #1 > 1604. 
05 if 009 BNEG 0$ ; 
58 oF dO 00095 MOVL § INDEX1, INDEX_VALUE : | 
g 11 00098 BRB 11$ ; | 
58 2 00 009A 10$:  MOVL  INDEX2, INDEX VALUE ; | 
50 54 or 009D 11$:  ASHL #1, INDEX NUMBER RO + 1606. 
FB A640 8 D1 OO0Al CMPL §_INDEX_VALOE, -8(BOUNDS)CROJ ; 
07 19 000A BLSS 12$ ; 
FC A640 58 D1 OO0A CMPL INDEX. VALUE , ~4 (BOUNDS) CROJ + 1607 
7 006 er iH GOAF 12$ ROY ZBL SASSK OUTRAN, =(SP) > 1609 
000000006 Ob 1 F B3 CALL a BAS Se OOP : 
51 08 A 04 C3 000BA 13$: SUBL3 #4. MULTIPLIERS, R1 > 1611 
30 3 6144 ¢ BF MULL3 (RI)CINDEX NUMBER], VALUE_LOCATION, RO ; 
5 58 ¢ C4 ADDL NDEX_VALUE, RO, VALUE_LOCATION ; | 
ec 11 6 (8 BRB : 1602 
50 : 3¢ OOOCA 148 MOVZWL (DESCRIP), RO > 1614 
50 C4 000CD MULL VALUE LOCATION, RO ; 
53 50 10 A ct D ADDL 6(DESCRIP), RO, VALUE_LOCATION ; 
18 02 as #1 p CMPB @(DESCRIP), #24 > 1615 
? i 06 0B MOVL § VALUE_LOCATION, TEMP_DESCRIP : 16 3 
3 04 A p DE MOVL 4(TEMP DESCRIPS, VALOE LOCATION : 16 
BF F 3 AS 91 OOOE2 158 CMPB 0s S(DESCRIP), #194 > 1631 
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1-03 


000000006 98 
04 


7 
000000006 3 
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; Routine Size: 280 bytes, 


> 1486 1650 1 


Routine Base: 
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i Hes 
OF OOEC 
DO G0F| 
DD Fi 
06 ore 
i 
9 1 
1 104 
i Hiss 
ob 
C b147 
0 117 
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2 
~sen~ 138+ 1:29:44 AX-11 Bliss-32 V 
~$ep-1984 11:56:46 BASRTL.SRC BaevIRTUA.B 
BNEQ 16$ 
CLRL  —s- VALUE 
PUSHAB VALUE 
PUSHL VALUE_LOCATION 
PUSHL gsc 
CALLS #3, BASSS$VA_FETCH 
MOVL ALUE, RO 
16$ CMPB (DESCRIP), #4 
BEQL 7$ 
MOVZBL M#BASSK_NOTIMP, -(SP) 
CALLS #1, BASSS$STOP 
17$: CvTW VALUE LOCATION), RO 
18$: ADDL #20, SP 


K 2 
wo 1enSep-1986 1:80:46 EBASRILSSRESBASVIR 


1 Ne Page 47 
6:46 BASRTL. VIRTUA.B52;1 (8) 


; 1488 1651 1 GLOBAL ROUTINE BASSSTO_FA_W_RB ( ! Store a word 

3 1oeR 16 ¢ 1 VALUE ! The value to store 

: 1490 16 1 DESCRIP : REF BLOCK (8, BYTE), ! The descriptor to store into 

3 1491 1654 1 INDEX1, ' First index 

3 1036 1655 1 INDEX2 ! Second index 

3; 149 16 § 1 ) : VA_JSB NOVALUE = 

> 1494 1657 1 

3 1495 1658 1 !4¢ 

3 \7oe 1659 1 ! FUNCTIONAL DESCRIPTION: 

3; 149 1660 1! 

3 1498 1661 1! Store a 16-bit word in an array or virtual array. 
3 1499 1996 1! 

3; 1500 166 1 ! FORMAL PARAMETERS: 

3; 1501 1664 1! 

3 1208 1665 1! VALUE .rw.v The value to store 

; 150 1906 1! DESCRIP.rw.da The descriptor of the array or virtual array 
3 1504 1667 1! INDEX1.rl.v The first index into the array 
3; 1505 1668 1! INDEX2.rl.v The second index into the array 
g 1208 + «34 1! 
: 150 1670 1! IMPLICIT INPUTS: 
; 1508 1671 1! 
3 1509 1676 1! NONE 
3; 1510 167 1! 

3 1511 1674 1 =! IMPLICIT OUTPUTS: 

3 1316 1675 1! 

3 151 1676 1! NONE 

3 1514 1677 1! 

3 1515 1678 1 ! ROUTINE VALUE: 

3 1516 1679 1 ! COM°LETION CODES: 

3 1517 1680 1! 
3; 1518 1681 1! NONE 

3 1519 oes 1! 
; 1520 1683 1 | SIDE EFFECTS: | 
3; 1521 1684 1! 
3 1522 1685 1! Signals if an error is encountered. 
3 1523 1686 1! 
3 1524 1687 1 !-- 
3 1525 1688 1 

3: 1526 1689 BEGIN 
3: 1527 1690 
3; 1528 1691 LOCAL 

3 1363 1696 BOUNDS : REF VECTOR 

: 15 169 MULTIPLIERS : REF VECTOR, 

5 133) 1694 LOW INDEX, 

3 15 § 1695 HIGH_INDEX 

3; 153 1698 INDEX_INC 

: 1334 169 VALUE-LOCATION, | 
3; 1535 1698 INDEX_ VALU 

: 15 1699 INDEX~NUMBER; 

i 42 1701 

: io 

; 344 4 $ : Be sure the array has at least one but no more than two dimensions. 

: 1541 1704 | 
; 1366 1706 IF ((, DESCRIP COSC$B_DIMCT] LSSU 1) OR (.DESCRIP COSC$B_DIMCT] GTRU 2)) IHEN BASSSSTOP (BASSK_ONEOR_TWO) | 
: 1544 17 '¢ 
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BASS ence a Be PT e2te | HANSA Ose SpacuiRiGa 6S2; 9° 8) 


: i 1708 3 | _Be sure this array or virtual array holds words. 

> 154 1710 

H } rk Whe 3 IF (.DESCRIP COSCSB_DTYPE] NEQU DSCSK_DTYPE_W) THEN BASS$S$STOP (BASSK_ARGDONMAT); 
: 1550 171 

: i ay | "The coefficients and bounds must be present 

:1 171 

3 1 ez 119 4 IF ( NOT (DESCRIP CDSC$V_FL coRrra AND ! 

; 1386 at .DESCRIP CDSC$V _FL_BOONDS 

; 1387 7 6 BASSSSTOP (BASSK_ARGDONMAT) ; 

: 1559 17¢@ MULTIPLIERS = DESCRIP CDSC$L_M1); 

3 1399 \? Z BOUNDS = DESCRIP CDSCS$L_M1] * (ZUPVAL* DESCRIP CDOSC$B_DIMCTI); 

; 1206 1725 "Quaoute the lower and upper index numbers based on how the array 

3 Veer 1766 _is stored. 

> 1565 1728 

; 1208 1? > Ne f° DESCRIP COSCS$V_FL_COLUMN]) 

> 1568 1731 

: 1569 1736 oy INDEX = DESCRIP CDOSCS$B_DIMCT); 

3; 1570 173 HIGR_INDEX = 1; 

: 1571 1734 INDER_INCR = |; 

1305 1736 

3 1574 1737 x BEGIN 

3; 1575 1536 LOW INDEX = 1; 

3 1376 1739 HIGA_INDEX = ,DESCRIP COSC$B_DIMCTI; 

3 1577 1740 INDER_INCR = 1; 

on * 

; 1380 1763 3 INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

; 1286 1002 i “Compute the Linear index from the indices provided. 

; 1384 1742 3° VALUE_LOCATION = 0; 

: 1258 170? WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_ INDEX + .INDEX_INCR)) DO 
: 1288 Ha} INDEX_VALUE = (IF (.INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 

: 1590 173 IF “. aa te VALUE LSS .BOUNDS C(.INDEX_NUMBER - 1)*2]) ! 

3 133) 1738 4 ‘ ex (, INDEX_VALUE GTR »BOUNDS C((. INDEX_NUMBER - 1)*2) + 1))) 

: 1398 1736 BASSSSTOP (BAS$K_SUBOUTRAN) ; 

; He 1728 YUE LOCATION = (.VALUE_LOCATION®*.MULTIPLIERS C.INDEX_NUMBER - 1]) + .INDEX_VALUE; 
: 159 1760 

3 1358 170) VALUE_LOCATION = (,.VALUE_LOCATION®.DESCRIP CDSC$W_LENGTH]) + .DESCRIP CDSC$A_A0]; 
; 1600 1788 i Special handling for virtual arrays. 

3; 1601 1764 ie 


mM 2 
a 1er$ep-1986 11:86:46 EBASRTL SRE SBASVIRTUA.882; 1 Pane 6) 


; 16 1765 
; 1808 176 F (.DESCRIP COSC$B_CLASS] EQLU DSC$K_CLASS_BFA) 
> 1604 1589 HEN . - . 
: 1605 1768 BEGIN 
3 160 1769 BAS SVA_STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 
: 1608 1771 ELSE 
1890 1558 ets 
3 1611 1726 IF (.DESCRIP CDSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSS$STOP (BAS$K_NOTIMP); 
; 1818 1776 16 
3 1ele rer t Store the value provided into the array 
> 1616 1779 BLOCK C.VALUE_LOCATION, 0, 0, %BPVAL/2, 1] = .VALUE; 
: 1617 1780 ‘ END; 
: 1618 1781 
3 1619 1782 1 END; ! end of BAS$STO_FA_W_R8 
5E 10 C2 00000 BASS$STO_FA_W_R8:: 
SUBL2 #16, SP : 1651. 
56 51 DO 00003 move : 
Oc AE 50 DO 00006 MOVL LUE ; 
54 0B A6 9A OOODA MOVZBL Hy oy ethiey, RG ; 1705 
05 13 0000 BEQL ~=«*1$ ; 
02 54 91 0001 CMPB RG, 2 : | 
08 1B 0001 BLEQU 28° : | 
7E 00G 8F 9A 90013 1$: MOVZBL #BASSK_ONEOR_TwO, -(SP) ; 
000000006 00 01 FB 00019 CALLS #1, BAS$$STO : | 
07 02 Ab 91 00020 28: CMPB (DESCRIP), #7 t 1711) 
0B 13 00024 BEQL ; 
7E 00G 8F 9A 00026 MOVZBL aBASSK ARGDONMAT, -(SP) ; 
000000006 00 01 FB 0002A CALLS. #1, : 
05 OA AG. 06 El 0031 3$: BBC #6. TOCDESCRIP), 4$ $1717) 
0A A6 95 000 TSTB ©—- 10¢ DESCRIP) > 1718) 
B 19 00039 BLSS 5$ ; 
7E 00G 8F 9A 0038 4$ MOVZBL #BASS$K_ARGDONMAT, -(SP) > 1720 | 
000000006 00 1 FB 0003F CALLS #1, BASSS$STOP ; 
04 Ac 14 Ab YE 00046 58 MOVAB ‘ TS) “MULTIPLIERS : 17 2 
5 14 A644 DE 4 MOVAL CDESERIPYL RG, BOUNDS : 1723. 
0B 0A Ab 05 E 2 BBC #5, 10(DESCRIP), 6$ > 1729 
51 4 00 0 MOVL  R4. LOW INDEX : 17 4 
50 ig: 0058 MOVL #1. HIGA_INDEX : 17 | 
bE 1 CE O98 MNEGL #1, INDER_INCR > 1734 
9 11 000 BRB 7$ > 1729 | 
1 1 D0 6$ MOVL #1, LOW_INDEX + 1738 | 
0 4 D0 MOVL  R4. HIGR_INDEX : 1739 | 
E 01 D9 66 MOVL. #1. INDER_INCR : 1740 | 
55 1 ge C 0 69 7$ SUBL3 INDEX_INCR, LOW_INDEX, INDEX_NUMBER > 1743 
4 54 D CLRL_ VALUE“LOCATI > 1247 | 
08 AE 50 6— C1 0006F ADDL3 INDEXTINCR, HIGH INDEX, 8(SP) > 1749 | 
$f CO 6 4 8S ADDL2 INDEX™INCR. INDER NUMBER ; 
08 AE D1 00077 CMPL INDEX"NUMBER, 8(SP) ; 


BASSYIRTUAL ARR 


50 


000000006 
04 


ww 
sor 


BF 


000000006 


000000006 


3 1620 1783 1 


F8 A740 
FC A740 


o 
oS 
a 
ec 
—POCOSOYS (“OW P — PW PViwVnWd NM LS OOWOMOMOMOMOVW 
OM MD AOUNA SE MOOA LAS OUND ONO" WWE 


; Routine Size: 242 bytes, Routine Base: 
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peal 
SF SSooOSSCOSCOOSCOOCOSOOSOSOSCSOOSOSOSOSOOOCOOSOSOOSOSOoOOoOoOOo 
SRMMOSSSCSRAOROASSODOSSSOCOSODROOOSIS _ 


COD 7O-O] MIO O—" ODN TWN NO 9 SO NOG o> 
MMMMOCGTIVCVMOOOCOwTWwIIOr>r>r OWO 


So MOOD SWB 9 FAN SV FO MH MH FU O"- DO" ON ww 


> 


AM SWS ONOMO ONNG F&F NU OO NOOO SF Vim pS 


_—— 
PM 


Yared BL iss-32 v4 748 
BASRTL. SRC IBASVIRTUA.B32; 1 
EX_NUMBER, #1 
EX1, INDEX_VALUE 
EX2 INDEX, VALUE | 
rst 

ek NVALOES {BOUNDS CROJ 
EX_VALUE, -4 (BOUNDS) CROJ 
BAS$K aster -(SP) 

BUC TIPLIERS 
fu: ) CINDEX A HERBERT. VALUE_LOCATION, RO 
[NOEX. VALUE, RO, VALUE_LOTATION 
(DESCRIP) 

VALUE seearto RO 

DESCRIP), mo VALUE_LOCATION 

SepeecRiPD. 194 
14$ 
VALUE 
VALUE TOcATION 
ee Shsseva _STORE 
16$ 
S(DESCRIP), # 

#BASSK NOT IMP, -(SP) 
a TOP 


BA 
VALUE (VALUE _LOCATION) 


16, SP 


PVRS: VOT VS 


3 
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| 1-03 14-Sep-1984 11:56:46 BASRTL.SRC JBASVIRTUA.B32;1 (9) 

3; 16 ¢ 1784 1 GLOBAL ROUTINE BASSFET_FA L RE ( ' Fetch a Longword 

3; 16 1785 (1 DESCRIP : REF BLOCK™C8, BYTE], ! The descriptor to fetch from 

> 1624 1786 1 INDEX1, ' First index 

: 1625 1787 1 INDEX2 ! Second index 

3; 1626 1788 «#1 ) : VA_JSB = , 

3; 1627 1789 «(1 

; 1628 1790 1 !4¢ 

: 1629 1791 1 ! FUNCTIONAL DESCRIPTION: 

; 1650 1736 1! 

: 3 1 at, : Fetch a 32-bit longword from an array or virtual array. 

3; 16 : 1795 1 ! FORMAL PARAMETERS: 

3: 1634 1796 1! 

; 1635 1797 1! DESCRIP.rl.da The descriptor of the array or virtual array 

; 1636 te. Bp INDEX1.rl.v The first index into the array 

3: 1637 1799 1! INDEX2.rl.v The second index into the array 

; 1638 1800 1! 

3; 1639 1801 1 ! IMPLICIT INPUTS: 

; 1640 1306 1! 

3: 1641 1803 1! NONE 

> 1642 1806 1! 

3 1643 1805 1 ! IMPLICIT OUTPUTS: 

3 1644 1806 1! 

: 1645 1807 1! NONE 

> 1646 1808 1! 

3 1647 1809 1 ! ROUTINE VALUE: 

> 1648 1810 1 ! COMPLETION CODES: 

3: 1649 1811 1! 

3; 1650 ale 1! The longword from the array or virtual array 

3; 1651 1815 1! 

: S26 1814 1 ! SIDE EFFECTS: 

3; 165 1815 1! 

3: 1654 1816 1! Signals if an error is encountered. 

3; 1655 1817 1! 

3; 1656 1818 1 !-- 

3 1657 1819 1 

: 1658 1820 2 BEGIN 

3; 1659 1821 2 

: 1660 1366 2 LOCAL 

3; 1661 182 BOUNDS : REF VECTOR 

; 166¢ 1824 MULTIPLIERS : REF VECTOR, 

3: 166 1825 LOW INDEX, 

3: 1664 1826 HIGH_INDEX, 

: 1665 1827 INDEX_INC 

> 1666 1828 VALUE LOCATION, 

3: 1667 Ht INDEX_VALUE, 

: 1668 1830 INDEX NUMBER, 

: 1669 1831 TEMP_BESCRIP: REF BLOCKC BYTE); 

3: 1670 S36 

3: 1671 183 '¢ p 

: 1o7¢ 1834 ' Be sure the array has at least one but no more than two dimensions. 

; 187% 1836 3 

: i 4 Ht H4 IF ((. DESCRIP CDOSC$B_DIMCT) LSSU 1) OR (.DESCRIP CDSCSB_DIMCT] GTRU 2)) THEN BASSSSTOP (BASSK_ONEOR_TwWO) 

3 1677 1839 '¢ : 

3; 1678 1840 ! Be sure this array or virtual array holds longwords. 
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3 
| BASSVIRTUAL_ARR 1S-se 1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 52 
BARES 12-8 08- 1 ope or 6:46 YBASRTL SRe BASVIRTUA.B32;1 . (9) 
15 1679 1. 
; 1680 
? 1 (.DESCRIP COSC$B_DTYPE] NEQU DSCSK_DTYPE_L) 
eRe IF (. DESCRIP COSCSB_DTYPE] EQLU DSCSK_DTYPE_DSC) 
oes THEN 
86 Special handling for dynamically mapped arrays. 
88 BEGIN 
90 TEMP_DESCRIP = .DESCRIP COSCSA_POINTER); 
91 IF (TTEMP_DESCRIP CDSCSB_DTYPET NEQU DSCSK_DTYPE_L) 
3 BASSSSTOP (BASS$K_ARGDONMAT); 


ELSE 
BASSSSTOP (BASS$K_ARGDONMAT) ; 


SSRVEAE 


! 
The coefficients and bounds must be present 


ooo 
wr 


IF ( NOT (,DESCRIP CDSC$V_FL COEFF AND 
DESCRIP CDSC$V_FL_BOONDS))) 


SF 


BASS$STOP (BAS$K_ARGDONMAT) ; 


; 
3 
; 
2 
§ MULTIPLIERS = DESCRIP CDSC$L_M1); 
: 
; 
: 


BOUNDS = DESCRIP CDSC$L_M1) * (ZUPVAL® DESCRIP CDSC$B_DIMCTI); 
Compute the lower and upper index numbers based on how the array 


s stored. 


IF (.DESCRIP CDSC$V_FL_COLUMN)) 
THEN 


BEGIN 
LOW, INDEX = .DESCRIP COSC$B_DIMCT); 
-i; 


DEX = 1; 
: = guescnee COSC$B_DIMCT); 


DODONAWUE WN 0 OD NAVE WN $0 ODA UE WN 0 ODNOAU ENO OONOU FW 
— 
z 
o 
m 
Bae] 
Dx 


00.09 09 09 09 09 09 09 09 00 SI NIN SS SIN NS SN SO PAA AA AAA A III BS EE 


INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
i Compute the Linear index from the indices provided. 
VALUE_LOCATION = 0; 
WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
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Se Se Be Ge Be Se Se Se Se Se Se Se Ge Fe Se Se Ge Se Ge Se Fe Ge Se Ge FH Sse Ge Se Ge Se Se Se Ge Se Se Be Se Se Ge Se Se Se Ge Se Ge Se Ge Se Ge Ge Ge Ge Se Ge Se See 
ed ed ed ad ee ce ee ee cee ee ce a a ed ld ea ce ee ee ce ce ee el ed ec ee ee ec ee ee ed eee 
ARUN OOO NOUE WN “OOD NAUE WN OOO N 
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_BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 53 if 
A083 = 12-808 -1 3b te 6:46 EBASRTL SRE BASVIRTUA.BS2:1 . (9) 
: 17 1898 BEGIN 
; 7 4 99 INDEX VALUE = (IF (. INDEX NUMBER EQL 1) THEN .INDEX? ELSE .INDEX2); 
5 1739 1901 IF ((,INDEX_VALUE LSS .BOUNDS C(.INDEX_NUMBER = 1)#2]) ! 
: 1740 190¢ 4 nen” (. INDEX VALUE GTR .BOUNDS (((.IRDEX_NUMBER = 1)*2) + 1))) 
; 124g 1904 BASSSSTOP (BASSK_SUBOUTRAN) ; 
> 1744 1906 VALUE LOCATION = (.VALUE_LOCATION®.MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
140g 1908 a: 
> 1747 1909 VALUE LOCATION = (.VALUE_LOCATION® DESCRIP CDSCS$W_LENGTH]) * .DESCRIP [DSC$A_AO]; 
> 1748 1910 IF DESCRIP CDSC$B_DTYPE] EQLU DSC$K_DTYPE_DSC 
21: rt 
> 1751 1918 i Special handling for dynamically mapped arrays. 
: 1738 1914 ie 
oi: me oa 
: 1755 1917 TEMP_DESCRIP = .VALUE_LOCATION; 
> 1756 1918 3 VALUE_LOCATION = .TEMP_DESCRIP COSCSA_POINTER); 
: 1757 1919 3 
1586 im tee oe 
: 1760 1998 i Special handling for virtual arrays. 
: 176) 1998 5° 
: 1768 1925 IF (.DESCRIP CDSC$B_CLASS] EQLU DSCS$K_CLASS_BFA) 
> 1764 1926 é THEN 
: 1765 1927 BEGIN 
3 1766 1928 ; 
: 1767 1929 LOCAL 
Ve Beg =p 
: 1770 1932 BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, VALUE); 
3 1771 1933 3 RETURN T.VALUE); 
: 158 1988 5 moe 
; 177% 1936 $ IF (.DESCRIP CDSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSS$STOP (BASSK_NOTIMP); 
: 1776 1938 1% 
3 Ve 1323 : Return the array element as our value. 
3 1779 1941 RETURN (.BLOCK C.VALUE_LOCATION, 0, 0, %BPVAL, 1)); 
; 1780 1942 1 END; ! end of BASSFET_FA_L_R8 
10 C2 00000 BASSFET_FA_L_RB:: 
‘ 1 Dd 000 Re O* * Beran 
55 3 06 0003 MOVL RO, RS ; 
53 0B AS 9A 000 MOVZBL 11(DESCRIP), R3 > 1837 
13 0000C BEQL ssi : 
02 1 0000€ CMPB RS, #2 ; 


re 


=32 V4.0-74 


YOASRTL SRE SBASVIRTUA.B92; 1 


AX-1 


|BASSVIRTUAL ARR 


| 


© COe-ROK—wR OR ORR 
SEL Oaor DHDS oo 
(60.60 00 00 00 00 G0 a0 00 00 00 60 40 


ce ee a ce ee ee ee 


1843 
186 
1899 


- ~ o Kon 
2 $38 SS = Sse 

=) a oro 
> £ + ae 


- - 


2 om © <3 

BS Do © wo 

- - --— 
.* 


*e*e *e*e te te te te Fe te te * SPS FS FS FS FS FSS FS FSS SSS FSS SHS SHS HS HSS FS HS HS SS SS SS HS SS SSCS FSCS HTS HSE CESS HR HCE FRESHER FE HS 


o 
a 
f+ 4 . 
wo a 
= = 
~ —-2z 2 
za «zo Ss oO 
'w wu — _ 
=x or _— ar 
ww ~- fF < << ae 
oe o Oo we vv aw 
2 <ze« wo oO vo 
a _ = ws ow wall ait Wu 
~~ os ~ ~ ” rw =~ ~ _~ ue 6G t w ft 
a <= a a a '- x “”volU6MlCUek aw [vv) ow 
” Vv ”“ ” 2 <= ww oaow >> | o 
~ w ~ ~ a ] w oOo dn es zw~ — a) aw 
a wo f cay - “now ao 22a w wo > i - sf <= z< 
az w eor ze a2 a2 @ @ en> o> w> 
8 t 5 - w _ x<~ + — @ @ . a [4 — 
54 as: = s be — 3s 8 ' caw — <« <«a~wr ww z ww © ~ os 
~r- =a ~ ann F oa- 82 > >wO w~w << DO Ov nO 
—- on wa a ama <a xxo2z-2Z ‘ i ‘' & e2fe Zan 2A 
as 2 +e an OAK KW UOT + '- =< x -aQw coo 2 O-2s 
Zo a ooc OOrwawoazt wok wy &£& ee w ww ° . 320 - aes ma 
Or « . ~~ BAF YLn OF UR VOAsZs B26) ee ow wh hUclUlC CU Shas os Rens ew se 
won A Aw OMMWA YOMDAW2Z=— | 2 Eevee aee«ewOoa ue. — <a <«4-— 
Zea a aw GQeue Geewe XS KYU ZU — —s« LJ Cems AWA Ow 
oe = §—§O <aVMoc «ae Fa tw cwzoe-Zz wt < “RrOoet AOC Co; 
war ac ae ft mw~wvu nm ww~BVvUa 253s" a4 . o> > wMouez> Se Ve . 
wav vw Vt wWEOYMW WIR MOOS —2 § oO tt ‘'—- wz 1 a Tso ‘(a nu aw 
AO ” WE 42Oemrw SBONwe st TK KOKO Kl CUMS Ke OW WEY 
“yo ww ww Ww a “4 «¢£a wooww ww ww Ww Ww aw MW DoOw XDuww 
<« 20 20 C8 @ = ~~ € ww F288 * * Bij ZOQR# QRH sOMVMOUHRC + =a WiI~OoeRw- a 
} ah 4 tha a Birth d 4 pate fp et byt mpm tempt fF St TLE LAE Let jm tat eal pap ATS LS ae tte 
et Bur eum Os BBB OB BUNS BBO SE BS SB te tt et Ht te BB BY Ow BE VE ore 
— | =! — ~ 
poe Ts 1) aw 2492 a) Lat) Ques sere 
SNUOIMIYIOINY OVnNosde 49U sosssetsssaGs sJosisnitognssss NsIwI@Oow@ 
ttt St $ tit tet tte tae 2 oS A F593 Sk SS LE EER TF RRS? 
+jOdtEwk ZOZwWOLOM JO ZOOMOOZSAFOOCOID IOS Ews ZOCGO“E IZ tI9CA ees e2essee5 
@OFCVMVOEVOZVOr-DEVTISTOFEITOFSTFIEVOVE CVOVATE@OE CVO OME ei <orztseacvozzsw 
o or ee > Sd ehh if ee eh 
“A “A “Af al Bs ww o- nun Mm w w 
- ™w mm ws mw Oo ~ t+] oa -—— - - — _ 
PO WIT OO EIT Ow. TP OOS OO WIMOSO Oe CMO ws SSS CSS —-oO eeu ~FTOEOOMO Ouey 
ee NA OT oe od oF FAIA DD ODON RM Dee SoOooo a= Ox<Bamor ool SeooSS 


A 
COOOOCOOOCOSOSOOSOOSSOSOSSOSOSOSSSSSSOSSSSOSSSSSOOSOSOSOSSSOSOSSSOSOOSSOoOoSoooeo 


Of Oe MK VO KML Oe NOS <£ OW COW - CQOOM TFT WORK MK NOK OOK ORK NEOMM RK KK OT KK NOO 
HOUR OK OP KOOL WOK OU OWOOY  OCOOYVOAR VOOR Or OR OM ORK Oe VEU REMOVE OOO 


De KNOWN A De. — OWN De. HN UII Wt EAPO OR. OD eT TO UMMA IE 
owod--atoac FSBOQSESSOSLOMOOOOMO SING ZMMNODCOMOMOMODOOTNODOM << COMES 
w - 


< @ oOo 
o oOo o o ’ 
oO NN WN CSO <= o wv wT ww oS om were 
oo oOo oOo oO co oOo -- o oo o -o oo 
woo ora wow WOWDMN.OW —OW- ww — © OTTO COC wWOoOWMmMOoO CCOoOm Mu 
rOO -—- mo rROE wOdqCMamnmM dt MMH and oO wm os = KROCNWN MMe wuncd 
<i <« 

oO oO oO Oo 
Oo oad oo <« w wz e~ wv o vw ow — 
Oo oo oo oO o oO o oOo —_— oo @ 
Oo So o =] 
o So o i=] 
So So o So 
o So So So 
So So So So 
oO oOo Oo o 

Val v wv oO -OoMmM ~ 

Oo o w w MAW wow 


F 3 
BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 
eH rs 1 ~3007 138% te 6:46 BASRTL SRE IBASVIRTUA. B92: 
14 12 €7 BNEQ 16$ 
10 AE OF €9 PUSHAB wae 
2 DD EC PUSHL VALUE_LOCATION 
DD OOOE PUSHL DESCRIP 
000000006 98 03 Fe OOF CALLS #3, BASSSVA_FETCH 
0 10 AE 00 OO0F MOVL VALUE, RO 
14 11 000FB BRB 1 
04 03 AS 91 OOOFD 168: CMPB 3(DESCRIP), #4 
0B 13 bn 10) BEQL 17$ 
7E 00G 8F 9A 00103 MOVZBL #BASSK_NOTIMP, -(SP) 
000000006 00 01 FB 00107 CALLS #1, BASSSSTOP 
50 63 oe B10 17$: MOVL (VALUE_LOCATION), RO 
5€ 14 C€O 00111 18$: ADDL2 #20, SP 
05 00114 RSB 
; Routine Size: 277 bytes, Routine Base: _BASSCODE + OBEF 


3; 1781 1943 1 


3 
+) BASSVIRTUAL_ARR 18-3 =1984 01:29:44  VAX-11 Bliss-32 v4.0-74 Page 56 
Assy eet iT Seer yet hg PRE re 9° 10) 


; 1783 1308 1 GLOBAL ROUTINE BASSSTO_FA_L_RB ( ! Store a longword 
; 17 1945 1 VALUE ! The value to store 
; 1785 1208 1 DESCRIP : REF BLOCK (8, BYTE), ! The descriptor to store into 
3 17 1947 1 INDEX1, ' First index 

: 178 1368 1 INDEX2 ! Second index 

3: 1788 1949 1 ) : VA_JSB NOVALUE = 

3; 1789 1950 1 

; 1790 1951 1 !4¢4 

3; 1791 1326 1 ! FUNCTIONAL DESCRIPTION: 

3 16 1953 1! s 

3 179 1954 1! Store a 32-bit longword in an array or virtual array. 

3 1794 1955 1! 

3; 1795 1328 1 ! FORMAL PARAMETERS: 

3 1798 1957 1! 

3 179 1958 1! VALUE.rl.v The value to store 

3; 1798 1959 1! DESCRIP.rl.da The descriptor of the array or virtual array 
; 1799 1960 1! INDEX1.rl.v The first index into the array 

3 HF 4 12o3 : INDEX2.rl.v The second index into the array 

; 196 1968 1 ! IMPLICIT INPUTS: 

: 180 1964 1! 

3: 1804 1965 1! NONE 

3; 1805 1966 1! 

3; 1806 1967 1 ! IMPLICIT OUTPUTS: 

; 1807 1968 1! 

3; 1808 1969 1! NONE 

; 1809 1970 1! 

; 1810 1971 1 ! ROUTINE VALUE: 

3; 1811 1378 1 ! COMPLETION CODES: 

3; 1812 1975 1! 

3 1815 1974 1! NONE 

3: 1814 1975 1! 

3; 1815 1976 1 ! SIDE EFFECTS: 

3; 1816 1977 1! 

; 1817 1978 1! Signals if an error is encountered. 

3; 1818 1979 1! 

3; 1819 1980 1 !-- 

3: 1820 1981 1 

: 1821 1982 BEGIN 

3 13ce 1983 

3; 182 1984 LOCAL 

3 1824 1985 BOUNDS : REF VECTOR 

> 1825 1986 MULTIPLIERS : REF VECTOR, 

3 1856 1987 LOW INDEX, 

; 18 1988 HIGRA_INDEX, 

3; 1828 1989 INDER_INCR 

; 1829 1990 VALUE LOCATION, 

3; 1830 1991 INDEX” VALUE 

; 1831 1998 INDEX~NUMBER; 

3 1336 199 

3; 183 1994 '¢ . 

3 Ht 1996 : Be sure the array has at least one but no more than two dimensions. 
: 18 199 

: 1837 Hh a | IF ((,DESCRIP CDSC$B_DIMCT] LSSU 1) OR (.DESCRIP CDSCS$B_DIMCT] GTRU 2)) THEN BASSS$STOP (BAS$K_ONEOR_ TWO) 
: 1839 2000 2 !+ 
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Be sure this array or virtual array holds longwords. 


IF (DESCRIP CDSC$B_DTYPE] NEQU DSCSK_DTYPE_L) THEN BASSS$STOP (BASS$K_ARGDONMAT) ; 


| The coefficients and bounds must be present 


IF ( NOT (DESCRIP CDSC$V_FL coer AND : 
-DESCRIP CDSCS$V_FL_BOONDS))) 


BASSSSTOP (BASS$K_ARGDONMAT); 


MULTIPLIERS = DESCRIP COSCSL_M1); 
BOUMDS = DESCRIP CDSC$L_M1) * (XUPVAL*.DESCRIP CDSC$B_DIMCT)); 


i Compute the lower and upper index numbers based on how the array 
is stored. 


IF (,DESCRIP CDOSCS$V_FL_COLUMNJ) 
THEN 


BEGIN 
LOW INDEX = .DESCRIP COSC$B_DIMCT); 
HIGA_INDEX = 1; 

INDER_INCR = 1; 

END 


LOW INDEX = 1; 
HIGA_ INDEX = .DESCRIP COSC$B_DIMCT); 
INDER_INCR 13 


INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 


Compute the Linear index from the indices provided. 


VALUE_LOCATION = 0; 
WHILE (CINDEX NUMBER = . INDEX NUMBER + .INDEX INCR) NEQ (.HIGH_INDEX * . INDEX INCR)) DO 
INDEX_VALUE = (IF (.INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


IF ((, INDEX VALUE LSS .BOUNDS C(.INDEX NUMBER = 1)#2]}) ! 
OR (.INBEX_VALUE GTR .BOUNDS (C((.IRNDEX_NUMBER = 1)*2) + 1])) 


THEN 
BASSSSTOP (BAS$K_SUBOUTRAN) ; 
UE LEAS ee = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER - 1]) + .INDEX_VALUE; 


VALUE_LOCATION = (.VALUE_LOCATION® DESCRIP COSC$W_LENGTH]) + .DESCRIP CDSC$A_A0); 


¢ 
Special handling for virtual arrays. 


reel 


—_——— 
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IRTUAL_ARR 16- Sep-1984 01: AX=11 Bliss-32 v4.0-74 : 
BARS =3e0 71 38e 91:88 :4 BASRTL.SRCIBASVIRTUA.B82; 1 al tT 5 


; 1897 

; 1898 838 IF (DESCRIP CDSC$B_CLASS] EQLU DSCS$K_CLASS_BFA) 

> 1899 960 THEN 

: 1900 61 BEGIN 

; 1901 O6¢ BAS SVA_STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 

: 190 064 ELSE 

; 1904 65 BEGIN 

; 190 067 IF (.DESCRIP CDSCS$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSSSTOP (BASSK_NOTIMP); 

: 1908 0 ‘6 

: P44 OF § | _Store the value provided into the array 

: 1911 07 BLOCK [C.VALUF_LOCATION, 0, 0, %BPVAL, 1] = .VALUE; 

t 131g a8 ENDS : we | 

: 1914 075 1 END; ! end of BAS$SSTO_FA_L_R8 | 
SE 10 


C2 00000 BAS$STO_FA_L_RB:: 
UBL2 #16, rf : 1944) 


56 51 pO 00003 MOVL - ; 
Oc AE 50 DO 00006 MOVL RO, VALUE ; 
54 0B A6 9A OOO0A MOV ZBL TT tDESCRIP) , RG : 1998 
05 13 9000 BEQL  ~=«'1$ : | 
02 54 91 0001 CMPB soéRG, #2 : | 
08 1B 0001 BLEQU : 
7E 006 8F 9A 00015 1$ MOVZBL HBASSK ONEOR_TWO, -(SP) : 
000000006 00 01 FB 00019 CALLS BASS$SSTOP : 
08 02 A6 91 9020 2$ CMPB eiitay #8 + 2004 | 
0B 13 900 4 BEQL $ : | 
7E 006 8F 9A 00026 MOVZBL MBASSK ARGDONMAT, -(SP) : | 
000000006 00 01 FB 0002A CALLS BASSSST ; 
5 OA Ab 06 EI 00031 3$: BBC TOWDESCRIPY 4$ > 2010. 
0A Ab 95 000 TSTB 1 Sine ESCRIP) : 2011. 
0B 19 00039 BLSS ; 
7E 00G 8F 9A 00038 4$ MOVZBL PBASSK ARGDONMAT, (SP) + 2013) 
000000006 00 1 FB 0003F CALLS #1, BASS$$STOP 3 
04 Ar 14 Ab 9E 00046 5S MOVAB g0{R6) MULTIPLIERS + 2015. 
5 14 A644 DF 004 MOVAL OCDE SCRIPIERG » BOUNDS > 2016. 
0B OA Ab 96 E 5 BBC #5, 10(DESCRIP). 6$ : 20 
51 4 0 005 MOVL  R4. LOW INDEX : 2025 | 
50 1D 0098 MOVL #1, HIGA_INDEX : 20 6 
6E 1 CF 0058 MNEGL #1, INDER_INCR ; 20 | 
9 05 BRB 7$ : 2022 | 
51 1 06 6$ MOVL #1, LOW_INDEX : 2031 | 
50 4 D0 6 MOVL R4, HIGA_INDEX > 20 4 
ef 1 0g $8 MOVL #1, INDER_INCR 3 2035 | 
55 1 gE C 69 7$: SUBL3 INDEX_INCR, LOW_INDEX, INDEX_NUMBER > 2036 | 
4 D4 0006D CLRL_ VALUE“LOCATI : 2040. 
08 AE 50 6— (C1 0 of ADDL3 INDEXINCR, HIGH INDEX, 8(SP) > 2042 
$f CO 4 8$: ADDL2 INDEXINCR UMBER ; | 
08 AE bi 00077 CMPL  - INDEXNUMBER, ) : 


a 
BASSVIRTUAL_ARR tb-se =1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 59 
BASS eaee=h 38s FT 882g | FAXSAT OSA Sake Yai’ 6S2. 1 9° 10) 
A 1 78 BEQL =s:«1:38 : 
01 p 7 cnPL JNDEX NUMBER, " + 2044 
58 b MOVL INDEX, INDEX, VALUE ; 
9$ RovL «INDEN2,_ INDEX. VALUE ; 
| 50 i 78 A10$: ASHL #1, INDEX NUMBER, RO i 2046 
FB A740 8 D4 CMPL INDEX_VALOE. -8 (BOUNDS) CROJ : 
FC A740 53 b 9 CML INDEX_VALUE , -4 (BOUNDS) CROJ + 2047 
7 006 8F 9A 0009C 118: MOVZBL #BAS$K_SUBOUTRAN, -(SP) + 2049 
ae a ES Mame ‘3 
51 04 AE 4 C3 000A7 12$:  SUBL3 #4, MULTIPLIERS, R1 + 2051 
50 54 6145 ¢5 O00AC MULL3 (RI) CINDEX NUMBER], VALUE_LOCATION, RO ; | 
54 50 58 ¢1 00081 ADDL INDEX_VALUE, RO, VALUE_LOCATION : | 
BD 11 00083 BRB $ + 2042. 
50 66 3¢ 000B7 13$ MOVZWL (DESCRIP), RO 3 2054 | 
50 4 (4 OO00BA MULL2 VALUE _LOCATION, RO : 
54 50 10 A6 C1 000BD ADDL3 16(DESCRIP), RO, VALUE_LOCATION : 
BF BF 03 A6 91 00¢¢ CMPB © 3(DESCRIP), #191 : 2059 
10 12 000¢ BNEQ 14$ : 
Oc AE 9F 00009 PUSHAB VALUE ; 2062 | 
54 DD O00CC PUSHL VALUE_LOCATION ; 
56 DD OO0cE PUSHL DESCRI : 
000000006 00 03 FB 9000 CALLS #3, BASSSVA_STORE ; | 
15 11 00007 BRB 16 + 2059 
04 03 Ad 9100009 148: CMPB 3(DESCRIP), #4 : 2067. 
0B 13 00000 BEQL 15$ F 
7E 00G 8F 9A OOODF MOVZBL #BAS$K_NOTIMP, -(SP) : 
000000006 00 01 FB 000E3 CALLS #1, BASS$$STOP F | 
64 OC AE DO OOOEA 158 MOVL. VALUE, (VALUE_LOCATION) : 2072 | 
5E 10 CO OOOEE 16$ ADDL2 #16, §P : 2075. 
05 000F1 RSB ; | 
3; Routine Size: 242 bytes, Routine Base: _BASSCODE + 0D04 


: 1915 2076 1 


K 3 
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; 1917 77 1 GLOBAL ROUTINE BASSFET_FA F -P8 ( ! Fetch a ryote number 

; 1318 8 1 PeseriP : REF BLOCK"C8, BYTE), ! The descriptor to fetch from 

3; 191 79 «1 INDEX1, ! First index 

3; 1920 080 1 INDEX2 ! Second index 

: 1921 081 1 ) : VA_JSB = 

3 19 ¢ bag 1 

3 19 85 1 !e4 

; 4 ¢ Bae } FUNCTIONAL DESCRIPTION: 

: 1? $ te } Fetch a single precision floating number from an array or virtual array. 

: 1928 1 ' FORMAL PARAMETERS: 

3 1929 1! 

3; 1930 090 1! DESCRIP.rf.da The descriptor of the array or virtual array 

3; 1931 091 1! INDEX1.rl.v The first index into the array 
3 193 092 1! INDEX2.rl.v The second index into the array 
3; 193 093 1! 
3 1934 094 1! IMPLICIT INPUTS: 
: 1935 095 1! 

3 1338 096 1! NONE 

3 19 097 1! 

3; 19 098 1°! IMPLICIT OUTPUTS: 

3 1939 099 1! 

3 1940 100 1! NONE 

3 1941 $10) 2 

; 1306 196 1 ! ROUTINE VALUE: 

3 194 2105 1 ! COMPLETION CODES: 

3: 1944 2104 1! 

3: 1945 105 1! The number from the array or virtual array 

3 1946 106 1! 
: 1947 107 1 ! SIDE EFFECTS: 
3; 1948 108 1! 
; 34 444 : Signats if an error is encountered. | 
2 ie 
2 | an 
> 1955 115 LOCAL 

3; 1956 2116 BOUNDS : REF VECTOR 

> 1957 117 MULTIPLIERS : REF VECTOR, 

3 1328 118 LOW INDEX, 

3; 1959 119 HIGA_INDEX, 

3; 1960 159 INDER_INC 

> 1961 121 VALUE "LOCATION, 

3 196 1 § INDEX_ VALUE 

3 196 1 INDEX "NUMBER, 

3 1964 124 VALUE, 

: ieee ! 5 TEMP_DESCRIP: REF BLOCKC,BYTE); 

: 1967 139 '¢ 

3 1969 133 : Be sure the array has at least one but no more than two dimensions. 

: 1970 130 2. 

; 1972 132 IF ((, DESCRIP CDOSC$B_DIMCT] LSSU 1) OR (.DESCRIP CDOSC$B_DIMCT] GTRU 2)) THEN BASSSSTOP (BASSK_ONEOR_TWO) | 
: 197 1 '¢ 
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i sure this array or virtual array holds floating values. 


ew (DESCRIP CDSCS$B_DTYPE] NEQU DSCSK_DTYPE_F) 
rat -DESCRIP COSCSB_DTYPE] EQLU DSCSK_DTYPE_DSC) 
' 


& 
_Special handling for dynamically mapped arrays. 
BEGIN 


TEMP_DESCRIP = DESCRIP COSCSA_POINTER]; 
IF ([TEMP_DESCRIP COSCSB_DTYPEJ NEQU DSCSK_DTYPE_F) 


HEN 

BASSS$STOP (BASS$K_ARGDONMAT) ; 
ge? | 
st BASSSSTOP (BAS$K_ARGDONMAT) ; 


RAR 


Soon 


SESSSSSSSVless 


38 


$3333 
VEWnN— 


“The coefficients and bounds must be present 


SEES. 


IF ( NOT (.DESCRIP cpscey Fi COEFF AND ' 


f 
E He 
: 
E 


S 


N 
BASS$SSTOP (BASSK _ARGDONMAT) ; 


oo 
See 


MULTIPLIERS = DESCRIP CDSC$L_M1); 
te BOUNDS = DESCRIP CDSC$L_M1) * (ZUPVAL*® DESCRIP CDSC$B_DIMCT)); | 
i Compute the lower and upper index numbers based on how the array 
tl is stored. 


sss 
ooo 
“ 


3 


IF (,DESCRIP CDSC$V_FL_COLUMN]) 
THEN 


© ofescase COSC$B_DIMCT); 
-i; | 


CSOoooooeooeo 
Oo Se ow 


NDEX = 1; 

HIGA ieee . jDESCRIP COSC$B_DIMCTI; 
INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

i _Compute the Linear index from the indices provided. 

VALUE_LOCATION = 0; 


NOUS WMO OONOUS WN Oo 


Cooooooooo 
ee ee ced ce ce ee ee ee ee ce ee ce ce a a ee ce ee cee ce ce ce ce ee ce ee ee ce a ee ee ce ee ee ee ee ee ee ee ee a ed ed 


30009090909 0909 0909 09 SI NIN SIN SN SOB DD AA PADD TTI B= BS EEE PAA 
SOONG NEW 0 ODNOAUES WIN 0 OD NOUS WIN 0 ODNAU EWN SO OONO NEW OC ONOUS 


SSSSSSSSSSSSSSSSSSSSSSSSSS3SS33I35SSSISLLIGL0G 0G L0G LLG 
o~ 


Be Se Se Se Se Se Se Se Ge Se Se Se Ge Se Se Ge Ge Sse Ge Se Se Se Ge FF Se Se Fe Ge Gs Ge Se Ge Se Se Se Se Se Se Sse Se Se Se Se Se Se Sse Se So Se Se Ge Se Se Se Seeses 
RIPIPIPOPINIPINIAPINIPININPIPIAINPININININININININININININININIMIPINININININD 


WiPorononofonnonon 


ooo 
Ooew 


> —————_—_—_————— 


M 
ASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 Pa 2) 
ai 122838- 1382 i 6:46 EBASRTL SRC BASVIRiUA-B82;1 9° 495 
satats | ate paaianat = INDEX NUMBER + .INDEX_INCR) NEQ (.HIGH INDEX + .INDEX_INCR)) DO 
INDEX _VALUE = (CIF (. INDEX NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


IF ((, INDEX VALUE LSS .BOUNDS C(.INDEX NUMBER = 1)#2]) -! 
OR (.INDEX_VALUE GTR .BOUNDS [((. INDEX NUMBER = 1)*2) + 1])) 


N 
BASSS$STOP (BASSK_SUBOUTRAN) ; 
Pe LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 


Wr 


wu 


TION 


rh - VALUE LOCATION® .DESCRI 


ON = .D P CDSC$W_LENGTH]) + .DESCRIP CDSC$A_AO); 
DSC$B_DTYPE] EQLU DSC$k_DTYPE_DSC 


VALUE LOC 
IF .DESCR 
THEN | 

i 


Special handling for dynamically mapped arrays. 
BEGIN 


TEMP DESCRIP = .VALUE_ LOCATION; 


4 
IP = : 

VALUE_LOCATION = .TEMP_DESCRIP COSCSA_POINTER); 
END; 
'¢ 
Special handling for virtual arrays. 
IF (.DESCRIP COSCS$B_CLASS] EQLU DSCSK_CLASS_BFA) 

5 BEGIN 


LOCAL 
VALUE ; 


BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, VALUE); 
FY a T. VALUE); 
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a ; 1 IF (.DESCRIP CDSC$B_CLASS] NEQU DSCS$K_CLASS_A) THEN BASS$STOP (BASS$K_NOTIMP); 
07 + 

673 2 : ! Fetch the value using the MOVF instruction to be sure that it is not 

Bre § : } a floating reserved operand. 

076 3 $ BASSSCOPY_F_R1 (.VALUE_LOCATION, VALUE); 

078 § 8 i Return the array element as our value. 

079 9 !- 

080 240 RETURN (.VALUE); 

081 241 END; ! end of BASSFET_FA_F_R8 


SE 14 C2 00000 BASSFET_FA_F_R8:: 
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BASSVIRTUAL _ARR 16-Sep-1984 01:29:4 AX-11 Bliss-32 V4.0-74 Page 63. 
Assy beatae 1 1:56: 46 BASRTL’ SRC IBASVIRTUA.B 2:1 . (11) | 
SUBL2 #20, SP : 2077) 
51 bp 0 03 PUSHL ff ; 
54 0 p 0 MOVL RO, R4 : | 
53 08 Ak 9A 00008 MOV ZBL VI{DESCRIPD, R3 3 2131 
02 53 oi O00E CHPB R3, #2 : 
7E 006 SA 0013 1$: MOVZBL #BASSK_ONEOR_TWO, -(SP) : 
000000006 00 1 €B 001 CALLS #1, BASS$STOP : | 
A 02 A4 94 1 2$: CMPB =-« 2( DESCRIP), #10 + 2137 
1B 13 000 BEQL 6s 4$ ; | 
18 02 AG ? 00 4 CMPB g(DESCRIP), #24 + 2139) 
OA 028 BNEQ 4 : | 
56 04 Ad DO O002A MOVL 4 (DESCRIP) TEMP. DESCRIP + 2146) 
OA 02 AG 94 09 : CPB @ (TEMP DESCRIP), “#10 + 214 
7E 00G 8F 9A 00034 3$ MOVZBL #BASS$K_ARGDONMAT, -(SP) + (2153 
000000006 00 01 FB 00036 CALLS #1, BASSS$STOP : 
05 OA AG 6 El OO3F 4$ BBC #6. 10(DESCRIP), 5$ + 2159 
OA AG 95 00044 TSTB  10(DESCRIP) + 2160 
0B 19 90047 BLSS 6$ ; 
7E 006 8F 9A 00049 5$ MOVZBL M#BASSK_ARGDONMAT, -(SP) + 2162 
000000006 00 01 FB 90040 CALLS #1, BASS$$STOP : 
08 AE 14 A& YE 00054 6$ MOVAB gina) MULTIPLIERS ; 2164 
5 14 A443 DE 00059 MOVAL 20(DESCRIP)CR3), BOUNDS + 2165 
0c OA Ad 05 €1 00056 BBC #5, 1O(DESCRIP). 7$ ; gi7i 
51 53 DO 0006 MOVL  R3, LOW_INDEX + 2174 | 
50 01 DO 00066 MOVL #1. HIGA_INDEX ; 3175 
04 AE 01 CE 00069 MNEGL #1, INDER_INCR 3 2176! 
OA 11 0006D BRB 3 ; Aras 
51 01 00 0006F 7$ MOVL #1, LOW_INDEX + 2180 
50 53 D0 00 i MOVL 3, HIGA_ INDEX > 2181 
04 AE am D0 0007 MOVL. #1. INDER_INCR ; g18¢ 
53 51 04 AE C3 00079 8$ SUBL3 INDEX_INCR, LOW INDEX, INDEX_NUMBER ; 218 
57 D4 b007E CLRL_ VALUE “LOCATION : 2189 
0c AE 04 BE4O 9€ 00080 MOV aINDER INCR HIGH INDEX], 12(SP) > 2191 
5 04 AE CO 00086 9$ ADDL2 INDEX_TNCR NDER_ NUMBER ; 
oc AE 53 D1 OOOBA CMPL INDEXIN URBER- 12(5P) ; 
3 13 0008E BEQL 4$ ; 
01 3 1 9090 CMPL INDEX NUMBER, #1 > 2193) 
05 if} 009 BNEG 0$ ; 
56 of DO 00095 MOVL INDEX1, INDEX_VALUE ; 
5 g 4 nie 10$ AOVL INDEX? INDEX. VALUE | 
50 5 Al ni 6096 11$:  ASHL #1, INDEX_N RO > 2195 | 
F8 A540 38 Dt 0A} CHPL Nex NVALOES Mat comes) ened ; | 
FC A540 38 p} OOAB CPL 1aex. VALUE, -4(BOUNDS) CROJ > 2196 
43 00G 8F 9A OOOAF 12$: MOVZBL #BASS$K_SUBOUTRAN, (SP) > 2198 
000000006 0 a. ¢ 0085 CALL . BASSSST OF ; 
51 08 AE 4 C3 000BA 13$: SUBL MULTIPLIER ; 2200. 
50 5 6143 ¢5 000BF MULL varity tees eRt VALUE_LOCATION, RO ; 
57 50 58 C1 0004 ADDL NDEX_VALUE, RO, VALUE_LOCATION ; 
Bc 11 000C8 BRB $ ; 3191 
50 64 3¢ OOOCA 14%:  MOVZWL (DESCRIP) + 2203. 
50 7 (4 000CD MULL2 VALUE RIOCATION, RO ; | 
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gt 9000 ADDL3 16(DESCRIP), RO, VALUE_LOCATION 
1 0000 CMPB) =s-s« 2( DESCRIP), #24 

1 0 09 BNEQ 15$ 

D DB MOVL § VALUE_LOCATION, TEMP_DESCRIP 

p 00D MOVL  4(TEMP_DESCRIPS, VALOE_LOCATION 

1 E2 15$: CMPB 9s: 3(DESCRIP), #194 

12 O00 BNEQ 16$ 

9F OO0E9 PUSHAB VALUE | 

BB OOOEC PUSHR #*M<R4 

FB OF O CALLS #3, BASSSVA_ FETCH 

DO OO0F MOVL VALUE, RO 

11 b00rB BRB 8$ 

91 OOOFD 16S: CMPB =s-s« 3(DESCRIP), #4 

13 90191 BEQL 17$ 

9A 00103 MOVZBL #BASS$K_NOTIMP, (SP) 

FB 00107 CALLS #1, BASS$$STOP 

9E OO10E 178 MOVAB VALUE, R1 

DO 0011 MOVL VALUE LOCATION, RO 

16 0011 JSB BASSSTOPY_F_R1 

DO 0011B MOVL. VALUE, RO 

CO OO11F 18$:  ADDL2 #24, SP 

05 00122 RSB 
+ ODF6 
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DER_INCR 
VALUE LOCATION, 
INDEX” VALUE 
INDE X~NUMBER; 
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te 
Be sure the array has at least one but no more than two dimensions. 


IF ((. DESCRIP CDSCSB_DIMCT] LSSU 1) OR (.DESCRIP CDSC$B_DIMCT] GTRU 2)) THEN BASSS$STOP (BASSK_ONEOR_TWO) 


“oo 
ono 


-19 

e=19 
: 20 43 1 GLOBAL ROUTINE BASSSTO_FA_F_R8 ( ! Store a floating value 
3; 2085 44 «1 VALUE ' The value to store 
3 20 45 1 DESCRIP : REF BLOCK (8, BYTE), i The descriptor to store into 
; 208 re 1 INDEX1, ' First index 
>; 2088 47 1 INDEX2 ' Second index 
3 oe, re ' ) : VA_JSB NOVALUE = 
> 2091 50 1 t+ 
H 038 23 . FUNCTIONAL DESCRIPTION: 
; Boe 38 : ! Store a single-precision value in an array or virtual array. 
3 2096 2 1 | FORMAL PARAMETERS: 
; 2097 2$ 1! 
; 2098 oF ..3 3 VALUE .rf.v The value to store 
3; 2099 58 1! DESCRIP.rf.da The descriptor of the array or virtual array 
: 2100 539. 1! NDEX1.rl.v The first index into the array 
3 13 : o : } INDEX2.rl.v The second index into the array 
: 108 : 6¢ 1! IMPLICIT INPUTS: 
; 2104 2265 1! 
: 2105 64 1 NONE 
> 2106 3 $ 65 1! 
3 2107 » 2266 1°! IMPLICIT OUTPUTS: 
: 2108 67 1! 
3; 2109 - 268 1! NONE 
; 2110 $88 3 
3 2111 2270 1 ! ROUTINE VALUE: 
3 Ng 271 +1 =! COMPLETION CODES: 
3; 211 $f 7? 
3 21146 7 1! NONE 
3 2115 2274 1! 
3 $136 ost? : SIDE EFFECTS: 
; sH18 $578 1} Signals if an error is encountered. 
Me BR: 
: 213) $580 . 
3 1¢¢ 2281 BEGIN 
3 3 $seg 
3 2124 28 LOCAL 
; \¢3 $sce BOUNDS : REF VECTOR 
: 2126 85 MULTIPLIERS : REF VECTOR, 
3: 2127 $o¢ LOW INDEX, 
3; 2128 8 HIGR_INDEX, 
3 it 94 288 IN 
ee 4 $82 
F 91 
: 38 
: 9% 
3 : 95 
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: hy sure this array or virtual array holds floating values. 


IF (.DESCRIP CDSCSB_DTYPE] NEQU DSCSK_DTYPE_F) THEN BASSS$STOP (BASSK_ARGDONMAT); 
i “the coefficients and bounds must be present 
IF ( NOT (DESCRIP CDOSC$V_FL cogres AND ' 
DESCRIP CDSCSV_FL _BO0NDS 


BASSSSTOP (BASS$K_ARGDONMAT); 


MULTIPLIERS = DESCRIP CDSCS$L_M1); 
BOUNDS = DESCRIP CDSCSL_M1) * (ZUPVAL*.DESCRIP COSCS$B_DIMCTJ); 


i Compute the lower and upper index numbers based on how the array 
i is stored. 
cs -DESCRIP COSCSV_FL_COLUMN]) 


BEGIN 
LOW at = .DESCRIP COSC$B_DIMCTI; 


DEX = 1; 
oe = «1; 


—t 
cogece cece SINS SIN NS SIOA AAA AA AAA A MMMM BEE PEE EE 
Seo BRAS BSSIO AR INI OOo WH AF wt oO Doo Grn Ud OO DO0 Orn ON 
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oo IN NDEX = 1 
tout INDEX = - DESCRIP CDSC$B_DIMCT); 
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4 
5 
is 
328 
4 
330 
331 
$36 joer = 1 
i 
335 INDEX NUMBER = .LOW_INDEX = .INDEX_INCR; 
7 3 | i i” Compute the Linear index from the indices provided. 
Fe VALUE_LOCATION = 0; 
31 WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX * .INDEX_INCR)) DO 
‘8 INDEX_VALUE = (IF (.INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 
5 IF ((. INDEX VALUE LSS .BOUNDS [(. fuper NUMBER - 1)#2)) 
14 ri] : aw (. INBEX_VALUE GTR .BOUNDS (((.INDEX_NUMBER - 1} #25 + 1))) 
44 £8 BASSSSTOP (BAS$K_SUBOUTRAN) ; 
3 29 He LOCATION = (.VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER - 1]) + .INDEX_VALUE; 
9 5 
$e 33 VALUE_LOCATION = (.VALUE_LOCATION® DESCRIP COSC$W_LENGTH]) + .DESCRIP CDSC$A_A0]; 
38 ‘2 ‘ Special handling for virtual arrays. 
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if 4 Sescne? COSC$B_CLASS] EQLU DSC$K_CLASS_BFA) 


BEGIN 
BASSSVA_sTORE (.DESCRIP, .VALUE_LOCATION, VALUE); 
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IF (.DESCRIP CDOSCSB_CLASS] NEQU DSCSK_CLASS_A) THEN BASSSSTOP (BASS$K_NOTIMP); 


'¢ 
Store the value provided into 


BASSSCOPY_F_R1 (VALUE, 
END; 


1 END; 
5E 10 
55 51 
Oc AE 50 
54 0B AS 
05 
02 54 
0B 
7E 00G 8F 
000000006 00 01 
OA 02 AS 
08 
7E 00G 8F 
000000006 00 01 
05 OA AS 06 
OA AS 
0B 
7E 00G 8F 
000000006 00 01 
04 AE 14 AS 
5 14 A544 
08 OA A 5 
1 4 
0 1 
6€ 1 
9 
1 1 
: i 
54 $f $f 
08 AE 0 6E 
4 of 
08 AE 4 


the array 


.VALUE_LOCATION) ; 


! end of BASSSTO_FA_F_R8 
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BAS$$STOP 


ASSSST 
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me gee cponmar. 
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éRIP BOUNDS 
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NDEX NUMBER 
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50 4 1 
FB A640 7 
FC A640 : 
43 00G 8F 

000000006 0 1 
50 04 Os 04 
51 2 6044 
57 1 58 
85 

51 g 
51 7 
57 51 10 AS 
BF CSF 03 as 
10 
Oc AE 
OOAO «BF 
000000006 00 93 
04 03 AS 
08 
7E 00G 8F 

000000006 9° 01 
0 oc ag 

51 5 
000000006 00 
SE 10 
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BASRTL.SRCJBASVIR 
13$ ; 
NDEX_NUMBER, #1 
NDEX1, INDEX_VALUE 
INDEX? INDEX, VALUE, 
Inben ures 
TNOEKS NVALOES CBOUNDS) CROJ 
NDEX_VALUE, =4(BOUNDS)CROJ 
#BASSK OUTRAN, -(SP) 
BASS$eTOP 
jg SUL TIPLS 
(RO) CINDEX” HEMER]. VALUE_LOCATION, R1 
NDEX_VALUE, R1, VALUE LOCATION 
(DESCRIP), RI 
(DESCRIP), Ri WiALUE _LOCATION 
$(DESCRIP), #194 


VALUE 
#OMCR 
#3 <SASSSvA. STORE 


s{RESCRIP). #4 
mBASS ar Hae 
BASSS 
VALUE, RO 
VALUE LOCATION, R1 
TY et se Rl 


-(SP) 


Poe 485 


2343 


: 2345 
: 2346 
; 2348 
: 2350 


: ot 
t 5365 
: 2358 
: 2361 


: 2358 
: 5366 


2371 | 
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: 2374. 
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BA IRTUAL_ARR 18-se -1984 01:29:44 AX-11 Bliss-32 V4.0-74 Page 69 
OAS Sy = 1 ~300-1 382 9: 6:46 BASRTL SREIBASVIRTOA- B82: 1 . a 
: 1 6 1 GLOBAL ROUTINE BASSFET_FA DFE ( ' Fetch a doublet loge ing 
: 221 77 (4 DESCRIP : REF BLOCK"C8, BYTE), ' The descriptor to fetch from 
; 0 4 1 INDEX), ' First index 
; 1 79 «1 INDEX2 ! Second index 
3 3 » ! ) : VA_JSB NOVALUE = 
: i ¢ 1 f+ 
3 5 i : } FUNCTIONAL DESCRIPTION: 
3 ; 5 : } Fetch a double-floating number from an array or virtual array. 
3 3 8) : FORMAL PARAMETERS: 
: 1 89 1! DESCRIP.rd.da The descriptor of the array or virtual array 
; § 90 1! IN flev The first index into the array 
; 4 : } INDEX2.rl.v The second index into the array 
; 5 3 1 ! IMPLICIT INPUTS: 
3; 2236 9% =«1! 
3; 2237 95 1! NONE 
; 2238 9 1! 
3; 2239 97 1 ! IMPLICIT OUTPUTS: 
3; 2240 98 1! 
3 2241 399 1! NONE 
g $seg 400 1! 
3: 224 401 1 =! ROUTINE VALUE: 
3 ssee rh : COMPLETION CODES: 
$ $se$ 3¢04 ; The double floating number from the array or virtual array 
: $ste guns 1 ! SIDE EFFECTS: 
3 $$e2 407 1! 
3; 2250 408 1! Signals if an error is encountered. 
3 $$2) 409 1! 
3 $26 410 1 !-- 
3; 225 411 1 
3 2254 tig BEGIN 
3; 2255 41 
3; 2256 414 LOCAL 
3 2257 415 BOUNDS : REF VECTOR 
3 2258 416 MULTIPLIERS : REF VECTOR, 
3; 2259 41 LOW INDEX, 
: 2260 418 HIGR_INDEX, 
3 $e! 41 INDER_INC 
; 6@ 420 VALUE~LOCATION, 
3 $6 421 INDEX” VALU 
3; 2264 4 ; DEX_NUMBE 
3 2265 4 VALUE™: VECTOR (2) 
i $266 424 TEMP_DESCRIP: REF GBLOCKC BYTE); 
3: 226 425 
3 2268 4 $ te ; 
3 $7 ; : Be sure the array has at least one but no more than two dimensions. 
: 2271 4 
: 2 “31 IF ((. DESCRIP CDOSC$B_DIMCT] LSSU 1) OR (.DESCRIP COSC$B_DIMCT] GTRU 2)) THEN BASSSSTOP (BASSK_ONEOR_TWO) 
: 227% 432 '¢ 
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ofescnsr COSCSB_DIMCT); 
-i; 


8 
LOW INDEX = 1; 
HIGA_INDEX = ,DESCRIP COSC$B_DIMCTI; 
INDER_INCR = 1; 
END; 

INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
: Compute the Linear index from the indices provided. 


VALUE_LOCATION = 0; 


3 re : ; Be sure this array or virtual array holds double-floating numbers. 
> 2e7 435 2° 

; g 4 6 IF (.DESCRIP CDSC$B_DTYPE] NEQU DSCSK_DTYPE_D) 

: 80 4 : IF (,DESCRIP CDSC$B_DTYPE] EQLU DSCSK_DTYPE_DSC) 

: 2281 4 THEN 

; S 440 '¢ 

3 th ret Special handling for dynamically mapped arrays. 
: 2285 cc8 BEGIN 

: 445 TEMP_DESCRIP = .DESCRIP CDSC$A_POINTER); 

; 88 446 4 IF CCTEMP_DESCRIP DSC$B_DTYPE] NEQU DSCSK_DTYPE_D) 
; 90 448 BASSSSTOP (BASSK_ARGDONMAT) ; 

: 229 450 END 

; 38 451 ELSE 

3 2294 43 BASSSSTOP (BASSK_ARGDONMAT); 

me ORD 

: ee HE The coefficients and bounds must be present 

: 2299 45 ; 

; $500 sien 4 IF ( NOT (.DESCRIP CDSC$V_FL_COEFF] AND 

3 2301 459 4 DESCRIP CDSC$V_FL_BOONDS3)) 

: Hs 3461 BASSSSTOP (BASSK_ARGDONMAT); 

: 2305 zc68 MULTIPLIERS = DESCRIP CDSC$L_M1); 

; 3306 464 ,, BOUNDS = DESCRIP CDSCSL_M1] F (ZUPVAL®.DESCRIP CDSC$B_DIMCT)); 
: £06 i Compute the lower and upper index numbers based on how the array 
; 46 ' is stored. 

: i gf 

; 470 IF (.DESCRIP COSC$V_FL_COLUMN]) 

; 471 THEN 

; 478 BEG! 

; 4 LOW INDEX = 

; ‘ 

; 4 EL 

; 4 

; 4 

; 4 

; 4 

; 4 

6 4 

; 4 

3 4 : 

; 4 

; 4 

: 4 

; 4 
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rt EES een aE = . INDEX NUMBER + .INDEX_INCR) NEQ (.HIGH INDEX * .INDEX_INCR)) DO 
" INDEX VALUE = (IF (. INDEX NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 

4 IF ((, INDEX VALUE LSS BOUNDS C(. INDEX NUMBER = jee? ; 

r THE OR (. INDEX_VALUE GTR .BOUNDS C((.INDEX_NUMBER = 1)*2) + 1))) 


N 
BASS$STOP (BASS$K_SUBOUTRAN) ; 
PS LRAT ION = (.VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 


MorrororororoTrorforoforry 
, a 
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3 ¢ 0 

i $a 

3 2335 § 

3 ; 5 4 

; 3 4 3 

> 2341 4 

SEE 388 

; 4 5 § VALUE_LOCATION = (.VALUE_LOCATION®.DESCRIP COSCS$W_LENGTH]) + .DESCRIP CDSC$A_A0); 
3 5 5 IF .DESCRIP COSCSB_DTYPE] EQLU DSC$K_DTYPE_DSC 

: re 2 : THEN 

: 308 2 $ j _soec tot handling for dynamically mapped arrays. 
3 3331 : ; BEGIN 

; 338 510 “TEMP_DESCRIP = .VALUE_LOCATION; 

: $27 213 VALUE_LOCATION = . TEMP_DESCRIP COSCSA_POINTER); 

; 2355 218 END; 

3 $29 seis '¢ 

3; 2357 515 ! Special handling for virtual arrays. 

3; 2358 5218 !- 

3; 2359 517 

3: 2360 518 IF (.DESCRIP CDSCS$B_CLASS] EQLU DSCS$K_CLASS_BFA) 

3; 2361 519 THEN 

; 306 520 BEGIN | 
3; 236 25) BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, VALUE); 
3 30% $2 ¢ ? BEGIN 

; 2366 3594 4 REGISTER 

3: 2367 525 4 RO = 0, 

Bee Be gh 

: 2370 528 4 RO = .VALUE 03; 

3 71 529 4 R1 = .VALUE (1); 

; ie: 530 4 RETURN; 

3; 237 531 END; 

3 se 5 ; END; 

: 316 ¢ IF (.DESCRIP CDSCSB_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$SSTOP (BASSK_NOTIMP); 
: 2378 4 1+ 

3; 2379 : Return the array element as our value. 

: 1 3 9 3° BEGIN 

; ; 40 

; 541 REGISTER 

3 226 RO = 0, 

3 5 $7 R1 = 1; 

; 238 545 BASSSCOPY_D_R1_(.VALUE_LOCATION, VALUE); 

3; 2388 546 RO = .VALOE"(0); 


———— 7 

Ba IRTUAL_ARR 18 we. 1984 01:29:44 AX-11 Bliss-32 V Pp 72 g 
“al ep- ad s$s- age 

pAa ey =3e87 1382 1:56:46 BASRTL. BR CIBASVI Vain e82; 1 913)” 1 

47 RI = VALUE (1); : 

rh END; 3 

50 END; ! end of BASSFET_FA_D_R8 : 

5E 14 C2 00000 BASSFET_FA_D_R8:: ; 

UBL2 #20, SP : 2376. 3 

1 pp 003 PUSHL : | : 

54 0 D MOVL : | ; 

53 0B A4 9A 00008 MOVZBL RD abcaspy, R3 : 2430. i 

03 13 900¢ BEQL : | ; 

02 91 00 OF CMPBSséR3, #2 : ; 

B 18 0001 BLEQU 3 | 3 

7E 006 BF 9A 0013 1$: MOVZBL HBASSK QNEOR TWO, =(SP) : | ; 

000000006 00 1 FB 0001 CALLS BASSSST : | ; 

0B 02 As 9 oor 2s: CPE 2beSCRIP). ont ; 2436 : 

18 02 Aa 91 00024 CMPB g(DESCRIP), #24 + 2438) ; 

OA 13 00028 BNEQ $ : ; 

56 04 A& DO 0002A MOVL 4 (DESCRIP), TEMP_DESCRIP : 2445 | ; 

02 A6 91 000 E CMPB =. 2( TEMP_DESCRIP) , #11 + 2446 | F 

0B 13 000 BEQL 4$ ; 3 

7E 006 8F 9A 00034 3$ MOVZBL #BASS$K_ARGDONMAT, -(SP) > 2452) : 

000000006 00 1 FB 0038 CALLS #1, BASS$$STO ; ; 

05 OA Ad 06 él OO3F 4$ BBC #6. 10(DESCRIP), 5$ : 2458) : 

0A Ad 95 00044 TSTB =: 10 DESCRIP) + 2459 | : 

0B 19 00047 BLSS 6% 3 3 

7E 00G 8F 9A 00049 5$ MOVZBL HBASSK ARGDONMAT, -(SP) > 2461 : 

000000006 00 01 FB 0004D CALLS BASSSSTOP ; : 

08 AE 4 A& GE 00054 68 MOV ; bined MULTIPLI + 2463 : 

5 14 A443 DE 0059 MOVAL (DESCRIP)CR3), “goUNDS + 2664 ; 

0c OA Ad 03 E 0056 BBC , 10(DESCRIP), + 2470 : 

51 5 00 006 MOVL R3, LOW INDEX + 2473 : 

50 01 DO 00066 MOVL #1, HIGA_INDEX + 2474 : 

04 AE 01 CE 00069 MNEGL #1, INDER_INCR > 2475 : 

A 11 0006D BRB 8$ + 2470 : 

51 1 00 O06F 7$: MOVL #1, LOW_INDEX + 2479 : 

50 3 pO 000 : MOVL R3, HIGA_INDEX + 2480 : 

04 AE 01 D9 07 MOVL. #1. INDER_INCR + 2481 : 

53 51 06 AE C3 00079 Bs: SUBL3 INDEX. INCR LOW_INDEX, INDEX_NUMBER : 484 : 

5 pA 7 CLRL. VALUE"LOCA HON : 2488 ; 

oc A 04 BE4O 5 00 MOV @INDER INCRCHIGH_ INDEX], 12(SP) + 2490 | : 

5 4 AE CO 00086 9S: ADDL2 INDEX _INCR INDER. NUMBER ; ; 

Oc «AE D1 96 A CMPL INDEX XNUMBER, 12(SP) ; | 3 

A i 0 BEQL 4$ 3 3 

01 3 p 0 CMPL INDEX NUMBER. #1 > 2492 | : 

5 9 BNEQ 0$ 3 3 

58 p 9 MOVL INDEX1, INDEX_VALUE F ; 

8k 108: ROVE INDEX2 INDEX VALUE Piva, 

50 38 8 90 11$:  ASHL #1, INDEX ER, RO > 2494 ; 

FB A540 4 Di Al CMPL tnsex x VALOE™ Mee soun@s) CRO} ; : 

07 19 0006 BLSS 2$ ; ; 


canis tae eR REED Goh SG yn 
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AO38 rie oe i ret et hg Pt Phe 9° 43) 
FC A540 8 p 0 Ag cMPL INDEX. VALUE , -4 (BOUNDS) CROJ : 2495. 
7 00G 8F 9A ar 128: MOVZBL #BAS$K_SUBOUTRAN, -(SP) t 2497 
000000096 8 1 & B3 CALL a1 BA siserop : atid, 
51 0 AE 4 ¢ BA 13$:  SUBL3 #4 eTTIPL IER 7 2499. 
29 2 6143 ¢ BF MULLS (RID CINDEX NUMER VALUE_LOCATION, RO ; 
0 58 ¢1 000C4 ADDL JNDEX, VALUE, RO, VALUE_LOCATION : 
ec 11 00¢8 BRB $ : 3490, 
50 64 C 0 CA 14$:  MOVZWL (DESCRIP), RO : 2502 
20 7 (4 000CD MULL ¢ VALUE_LOCATION : 
57 19 AG ci 000 ADDL3 16(DESCRIP), RO, RO ALUE _LOCATION : 
18 02 Ad 91 900 CMPB @{DESCRIP), “#26 + 2503) 
07 if D BNEQ 5$ ; 
56 7 0 0008 MOVL § VALUE_LOCATION, TEM ESCR IP ; 2510 
4 04 A6 00 0000 MOVL (TEMP DESCRIP) VALOR OCATION + 2511 
BF BF 03 As 9 OE 15$: CPE (DESCRIP), #194 : 2518 | 
10 AE 9F O00E9 PUSHAB VALUE | + 2521) 
0090 8F 8B OOOEC PUSHR #°M<R ; | 
000000006 00 03 re OOF CALLS a, BASSSVA_ FETCH t seas 
04 03 AG 91 000F9 16$:  CMPB 3(DESCRIP), # + 2534 
OB 13 OOOFD BEQL 17$ ; 
7E 00G 8F 9A OOOFF MOVZBL #BASS$K_NOTIMP, -(SP) : 
000000006 00 01 FB 00103 CALLS #1, BASS$$STOP ; 
51 10 AE i 0010A 17$:  MOVAB VALUE, R1 ; 2545) 
50 57 DO 0010E MOVL =‘ VALUE LOCATION, RO ; | 
000000006 00 16 00111 JSB BASSSCOPY_D_R1 ; 
50 10 AE 7D 00117 18$: mova OAT UE + 2546) 
SE 18 CO 00118 ADDL2 #24, §P : 2550) 
05 OO11E RSB : 
; Routine Size: 287 bytes, Routine Base: _BASSCODE + 1014 | 


; 2393 2551 1 
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408 


et at ot 2 tt I IO 
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ae 


SELLE 
Iw T ot at et et et 
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! Store a double-floating value 
° ! The value to store 


VALUE 
DESCRIP : REF BLOCK (8, BYTE], 
INDEX1, 


14-Sep- 
GLOBAL ROUTINE BASSSTO_FA_D_RB ( 
VALUE 
! The descriptor to store into 
' First index 
INDEX2 ! Second index 
) : VA_JSB NOVALUE = 
++ 
FUNCTIONAL DESCRIPTION: 
Store a 64-bit double floating value in an array or virtual array. 
FORMAL PARAMETERS: 
VALUE .rd.v The value to store 
(Passed as two longwords: VALUEO and VALUE1) 
DESCRIP.rd.da The descriptor of the array or virtual array 
INDEX1.rl.v The first index into the array 
INDEX2.rl.v The second index into the array 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 
Signals if an error is encountered. 


INDER_ 
VALUE “LOCATION, 
INDEX VALUE 


DE X"NUMBE 
VALUE”: VECTOR (2); 


'¢ 
: Put the double-precision input value into a local where it will be 


PORoPoPonoNgAoPoPONgNONPONINUNINUD) 2 2 9 9 tt a 
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eT 


VALUE Fo} = ,VALUEO; 
VALUE (1 »VALUE1; 


1+ 
Be sure the array has at least one but no more than two dimensions. 


H 609 
; 219 i 
3 61 
3 ol¢ ‘ 
; Se bie | 
; 38 a IF ((.DESCRIP COSCSB_DIMCT] LSSU 1) OR (.DESCRIP CDSCS$B_DIMCT] GTRU 2)) THEN BASS$STOP (BAS$K_ONEOR_TWO) | 
3 2460 g19 '¢ 
; red oi3 Be sure this array or virtual array holds double-floating values. i 
i 246 620 2. , | 
3 tee ‘ IF (.DESCRIP CDSCSB_DTYPE] NEQU DSCSK_DTYPE_D) THEN BASSS$STOP (BASS$K_ARGDONMAT) ; : 
3; 246 $e 4 ! The coefficients and bounds must be present i 
Me Rg ee || 
> 2470 ry St IF ( NOT (.DESCRIP CDSCS$V_FL_COEFF AND | 
; rea! 3698 3 . gr eenene? COSC$V_FL_BOONDS))) : 
; tf ? 3680 BASSSSTOP (BASS$K_ARGDONMAT) ; 
> 2475 2632 MULTIPLIERS = DESCRIP CDSC$L_M1]; | 
: sere 2634 im BOUNDS = DESCRIP CDSC$L_M1] = (ZUPVAL*.DESCRIP CDSC$B_DIMCT)); | : 
: 2478 63? i Compute the lower and upper index numbers based on how the array 
3; 2479 2636 ! is stored. : 
3; 2480 2637 2 !- i 
3; 2481 $038 § } 
3 2482 639 IF (.DESCRIP COSC$V_FL_COLUMN?) ; 
3; 2483 2640 THEN j 
3 2484 2641 BEGIN ; 
3; 2485 sete LOW_INDEX = .DESCRIP COSCS$B_DIMCTI; i 
3 2486 set 3 HIGA_INDEX = 1; ‘ 
3 2487 644 3 INDER_INCR = =1; ; 
3; 2488 2645 3 END : 
3; 2489 646 EL i 
; 2490 647 BEGIN | 
3 2491 648 LOW _ INDEX = 1; i 
3 249 2649 HIGRA_INDEX = ESCRIP COSC$B_DIMCT); ‘ 
> 249 2650 INDER_INCR = i; | 
3 2494 651 END; | : 
3 2495 636 
3 vhs} oe? ,, INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; ; 
; vhs 4 686 Compute the Linear index from the indices provided. | 
; 300 63 f VALUE _LOCATION = 0; 
; 206 67) WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
; 208 $89 INDEX_VALUE = (IF (.INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); ) 
; 306 66 IF ((.INDEX_VALUE LSS .BOUNDS (C(. INDEX NUMBER - 1) #22) ' 
3 4 068 ; : eu (, INDEX_VALUE GTR .BOUNDS [((.INDEX_NUMBER = 1)*2) + 1))) | 


N 4 
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—ffh 


BASS$STOP (BASS$K_SUBOUTRAN) ; 
PLE LOCATOR = (,VALUE_LOCATION® MULTIPLIERS C.INDEX NUMBER = 1]) + .INDEX_VALUE; 


VALUE_LOCATION = (.VALUE_LOCATION®.DESCRIP CDSCS$W_LENGTH]) + .DESCRIP CDSC$A_A0); 
Special handling for virtual arrays. 


If (DESCRIP CDSCSB_CLASS] EQLU DSCSK_CLASS_BFA) 


BEGIN 
BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 


IF (.DESCRIP CDOSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$$STOP (BASSK_NOTIMP); 


1+ 
Store the value provided into the array 


PASSSCOPY DAY (VALUE CO], .VALUE_LOCATION); 
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ROPIPIPINIPININININININININININININININININININIPININY 
PARRA AAAAAAAAAAAAAAAAO AAO on 


© OO 09 0909 09 G9 C9 C9 09 09 08 NINN SII NNO OOO 
MO OONAUE WN SO VENOULS WN ODONO 


= NIN AWA NI AI WAIN NINININININ 


. 
t 
. 
. 
e 
. 
2 
. 
. 
. 
e 
. 
. 
. 
e 
. 
e 
. 
e 
. 
os 
. 
e 
. 
cd 
. 
e 
. 
e 
- 
. 
. 
e 
° 
e 
. 
o 
7 
e 
. 
e 
. 
e 
. 
e 
. 
e 
> 
e 
. 
e 
* 
e 
. 
e 
o 
2 
© 
e 
o 
o 
° 
a 
. 
e 
o 
. 
e 
. 
e 
. 
2 
. 
J 
. 
e 
. 
e 
. 
¢ 
* 
e 
* 
e 
* 
e 
. 
e 
* 
e 
‘ 
e 
‘ 
S ] 
r 
4 
r 
q 
r 
4 
r) 
: 
‘ 
4 
4 
4 
‘ 
4 
‘ 
4 
‘ 
4 


| 
| 
END; ! end of BAS$STO_FA_D_R8 | 
| 
| 
5E 14 (C2 00000 BASSSTO_FA_D_R8:: 
SUBL2 #20, SP ; 2552) 
oc A 50 7D 00003 MOVG VALUEO, VALUE : 2609 
5 0B he 9A 00007 MOVZBL 11(DESCRIP), RS ; 2615 | 
05 13 00008 BEQL ='1$ : | 
02 55 91 00000 - CMPB sé, #2 ; 
0B 1B 00010 BLEQU 2$ ; | 
7E 006 8F 9A 00012 1$ MOVZBL #BAS$K_ONEOR TWO, -(SP) ; 
000000006 00 01 FB 00016 ALLS #1, BASSSSTOP ; 
08 02 a2 HI 001p 2$ CAPE g(DESCRIPD, #11 + 2621 
7E 006 8F 9A 000 ; MOVZBL M#BASSK_ARGDONMAT, -(SP) ; 
000000006 00 1 re 00 CALLS #1, BASS$SSTOP ; 
05 OA Ae : E 0 : 3$ BBC #6 1O(DESCRIP), 4$ : 2627. 
0A A2 95 000 TSTB  10(DESCRIP) > 2628 | 
0B 19 000 BLSS 6 5$ ; | 
7E 006 BF 9A 00038 48: MOVZBL #BAS$K_ARGDONMAT, -(SP) > 2630 
000000006 00 1 FB 000 CALLS. #1 BASS$STOP ; 
06 AE 14 Ag 9E 04 5$: OV ; (r2) MULTIPLIERS > 26 4 
56 14 A243 DE 0004 MOVAL CDESERIPDERS , BOUNDS > 2633. 
0B OA Ae 3 E 04 C #5, 10(DESCRIP), 6$ + 2639 | 
5 D9 5 MOVL R5, LOW INDEX + 2642 | 
50 1 0 004 OVL #1, HIGA INDEX > 264 
bE 1 CF 05 MNEGL #1, INDER_INCR > 2644 | 
9 11 00058 RB 7$ ; 


rn a 
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PAS 1e-8ep-19 4 te 6:46 BASRTL SREIBASVYRIOA 69251 9 14) 
1 1 D0 00050 6$ MOVL #1, LOW_INDEX 1 2648 
25 2 M4 60 MOVL RS, HIGA_INDEX + 2649 | 
6 01 00 6 MOVL. #1, INDER_INCR + 2650. 
55 6 C 66 7% SUBL3 INDEX_INCR, LOW INDEX, INDEX_NUMBER + 2653. 
D4 OO06A CLRL_ VALUE-LOCATION : 2657. 
08 AE 50 6— C1 906¢ ADDL3 INDEXTINCR, HIGH INDEX, 8(SP) : 2659 
6 CO 00071 8$ ADDL2 INDEX“INCR, INDEX NUMBER : | 
08 AE D1 00074 CMPL § INDEX"NUMBER, 8(SP) : | 
A 13 0078 BEQL «=_-«13$ : 
01 5 D1 0007A CMPL INDEX NUMBER. #1 + 2661 
0 if 00070 BNE $ . 
58 53 DO 0007F MOVL INDEX1, INDEX_VALUE : 
03 11 00082 BRB 0$ F 
58 54 00 00084 9 MOVL INDEX2, INDEX_VALUE : 
50 55 01 78 90087 10$ ASHL = #l,_‘I NUMBER, RO + 2663 
FB A640 58 D1 0008B CMPL §_ INDEX_VALOE, -8(BOUNDS)CROJ ; 
07 19 00090 BLSS 118 : 
FC A640 58 D1 0009¢ CMPL §_ INDEX_VALUE, -4(BOUNDS)([ROJ + 2664 
7€ 006 ge 33 90099 11$ BOY ZBL peAsse SUBOUTRAN, =(SP) > 2666 
000000006 00 01 Fe 90090 CALLS #1, BASSSSTOP : 
50 04 ag 04 C3 000A4 12$: SUBL3 #4. MULTIPLIERS, RO : 2668 
51 5 6045 ¢€5 000A9 MULL (RO) CINDEX_NUMBER], VALUE_LOCATION, R1 : 
57 51 58 C1 QOOAE ADDL INDEX_VALUE, R1, VALUE_LOCATION 3 
BD 11 00082 BRB 8 > 2659. 
51 62 3¢ 000B4 13$:  MOVZWL (DESCRIP), R1 + 2671 
51 57 C4 000B7 MULL2  VALUE_LOCATION, R1 : 
57 51 10 A2 C1 900A ADDL3 16(DESCRIP), R1, VALUE_LOCATION : 
BF BF 03 A2 91 000BF CMPB © 3(DESCRIP), #191 : 2676 
10 12 000C4 BNEQ 14$ ; 
OC AE 9F 000C6 PUSHAB VALUE : 2679 
0084 8F BB 000C9 PUSHR #*M<R2,R7> : 
000000006 00 03 FB 000CD CALLS #3, BASS$VA_STORE : 
1E 11 00004 BRB 1 : 2676 
04 03 A2 91 00006 148:  CMPB  3(DESCRIP), #4 >; 2684. 
OB 13 OOODA BEQL ; | 
7E 006 8F 9A 000DC MOVZBL #BASSK_NOTIMP, -(SP) : | 
000000006 00 01 FB OO0EO CALLS #1, BASSSSTOP t 
50 0c Ag 44 000E7 15$:  MOVAB VALUE, R + 2689 
51 5 DO OO0EB MOVL VALUE_LOCATION, R1 é 
000000006 00 16 OOOEE JSB BASSSCOPY_D_R1 ; 
5E 14 CO OOOFS 16%: ADDL2 #20, SP + 2692 
05 000F7 RSB : 
; Routine Size: 248 bytes, Routine Base: _BASSCODE + 1133 


w 
_ 


ROUTINE VALUE: 
COMPLETION CODES: 


5 
BASSVIRTUAL_ARR 1S-se -1984 01:29:44 AX-11 Bliss-32 V P 78 
Ag3h 12288-1886 fi iSeice  Eoasare $aeiaacvinton oS2:1 29° 45) 
7 693 GLOBAL ROUTINE wet “4 ty FA_B_R ' Fetch a 
3 694 Fasee’ * F BLOtK™ rg. BYTE), ' The deberlonee to fetch from 
26 $96 INDEX?” | besone tone 
re $35 ) : VA_JSB = op ee pang 
m0 ORB 
544 00 1 | FUNCTIONAL DESCRIPTION: 
545 701 
248 4 Fetch a byte from an array or virtual array. 
a8 ye FORMAL PARAMETERS: 
550 06 DESCRIP.rw.da The descriptor of the array or virtual array 
551 INDEX1.rl.v The first index into the array 
226 INDEX2.rl.v the second index into the array 
554 IMPLICIT INPUTS: 
$832 NONE 
557 
558 IMPLICIT OUTPUTS: 
559 
re NONE 
56 
$8 
5 


The byte from the array or virtual array 
SIDE EFFECTS: 


Vw 
o 
w 


SBUSAF 


SNS SSNS SNS 
WAI. ALAR PO PUNIPININININID) — OOO 
MEW 0 OSDNOUNE WN —OVOONOV EWN "OO 0O@~ 


BOUNDS : REF VECTOR 
MULTIPLIERS : REF VECTOR, 
LOW_ INDEX 
HIER INDEX. 
INDER_INCR 
VALUE -LOCATION, 
INDEX” VALUE 
INDEX ER, 
TEMP_DESCRIP: REF BLOCKC,BYTE); 


2 
5 
$2 Signals if an error is encountered. 
25 -- 
25 
$2 BEGIN 
5 LOCAL 
35 


'¢ 
i i Se sure the array has at least one but no more than two dimensions. 


PRIPSPIPOPIMINININININININD 
30.90 00 90 00 00 00 00 0000 <I SU SJ IU 


IF <(. DESCRIP COSC$B_DIMCT] LSSU 1) OR (.DESCRIP COSC$B_DIMCT] GTRU 2)) THEN BASSS$STOP (BASS$K_ONEOR_TWO) 


'¢ 
! Be sure this array or virtual array holds bytes. 


POPSPEPOPEPINPIMINGPMOPMONINDNY 

SSN NNN 
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beat batts rie ee rete ih og Cn 9°15) I 
>; 2594 750 te 
; 2595 751 

; 36 , ; IF (.DESCRIP CDSCSB_DTYPE] NEQU DSC$K_DTYPE_B) 

: 2598 754 IF (DESCRIP CDOSCSB_DTYPE] EQLU DSCSK_DTYPE_DSC) 

3; 2599 755 THEN 

3; 2600 7 ° '¢ 
: vet Pee } Special handling for dynamically mapped arrays. 

: 260 r8 BEGIN 

3 2604 760 

; 2605 761 H a DESCRIP = .DESCRIP COSCSA_POINTER]); 

3 ope 106 4 IF (TTEMP DESCRIP COSCSB DTYPEJ NEQU pstsx _DTYPE_B) 

; 2608 764 BASSSSTOP (BASSK_ARGDONMAT); 

3; 2509 765 

3; 2610 76 END 

3; 2611 76 ELSE 

3 aig ihe BASSSSTOP (BASSK_ARGDONMAT); 

; 261 769 

3 2614 770 '¢ 

3; 2615 771 i The coefficients and bounds must be present 

Bie Be gt 

; ty | sire IF ( NOT (,.DESCRIP COSCSV_FL_COEFF] AND .DESCRIP COSC$V_FL_BOUNDS])) THEN BASS$STOP (BAS$K_ARGDONMAT); 
; $630 2776 MULTIPLIERS = DESCRIP CDSC$L_M1); 

3 263 sire m BOUNDS = DESCRIP CDSC$L_M1) 3 (ZUPVAL® DESCRIP CDSC$B_DIMCT)); 

: £58 2779 i Compute the lower and upper index numbers based on how the array 

g so 4 $780 i is stored. 

3: 2625 781 tn 

3; 2626 ree 

3 soe 78 IF (.DESCRIP COSCS$V_FL_COLUMN)) 

3 2628 784 THEN 

5 soe? sree ecin 

; 26 786 re ee = .DESCRIP CDSC$B oDINCTI: 

; 2631 787 HGR. | = 1; 

; 632 788 INDER- NER = oF 

3; 263 789 

3: 2634 790 

3; 2635 791 

3; 2636 279 NDEX 

: 2637 79 rit INDEX” = "s escrip COSCS$B_DIMCTI; 

: 2638 794 INDER_I = 1; 

3: 2639 795 END; 

3: 2640 796 

3 ot a4 od INDEX NUMBER = .LOW_INDEX = .INDEX_INCR; 

: ec 4 : Compute the Linear index from the indices provided. 

: 645 801 VALUE_LOCATION = 0; 

: ver} 608 WHILE Ct INDER_SUMBER = INDEX NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + - INDEX_INCR)) DO 

; veh! She INDEX_VALUE = (IF (. INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


5 
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1-833 VeaSep-1984 1:50:66 EBASRTL SRESBASVIRIUA.B92; 1 945) 
- 2651 807 5 IF (CINDEX VALUE LSS_ -BOUNDS [(. INDEX NUMBER = 19227) 
3 Sees 4 4 (. INDEX_ VALUE GTR .BOUNDS C((. INDEX NUMBER - 1} #25 + 1))) 
; $28 19 BASSS$STOP (BAS$K_SUBOUTRAN); 
3 626 An Lp ROE = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
: 2658 814 ‘ 
3 2659 815 LUE_LOCATION = (.VALUE_LOCATION®.DESCRIP CDS DSCSW_LENGTHI) + .DESCRIP CDSC$A_A0]; 
; 2660 816 LOOESCRIP CDSC$B_DTYPE] EQLU DSC$K_DTYPE_DSC 
3; 2661 81 hes 
$808 819 i* 
3 ro £38 i Special handling for dynamically mapped arrays. 
; ee: 821 BEGIN 
3 2666 $B ¢ 
: 2667 8 TEMP_DESCRIP = .VALUE_LOCATION; 
: o68 Hy : VALUE_LOCATION = .TEMP_DESCRIP COSCSA_POINTER); 
3 3670 826 END; 
3; 2671 827 
3 sore 828 i "Special handling if this is a virtual array. 
3: 267 Sf 9 
3 2674 830 
3 2675 2831 IF (. DESCRIP CDSC$B_CLASS] EQLU DSCS$K_CLASS_BFA) 
3; 2676 sees 
3 2677 83 EN REGIN 
3; 2678 2834 
; t84 tH LOCAL 
3: 2680 836 VALUE; 
3; 2681 2837 
3 sone sete 
> 268 839 BASSSVA Pi rcH (.DESCRIP, .VALUE_LOCATION, VALUE); 
3 26Bh 3840 RETURN T. VALUE); 
: $08 ae _— 
; 268 2ac8 IF (DESCRIP CDSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSSSTOP (BASSK_NOTIMP); 
3 2689 845 
3 on 528 | "Return the array element as our value. 
3 269 g848 RETURN (.BLOCK [.VALUE_LOCATION, 0, 0, XBPUNIT, 1]); 
3 269 B49 1 END; ! end of BASSFET_FA_B_R8 
5E 10 C2 00000 BASSFET_FA_B _RB:: 
UBL2 #16, SP 3; 2693) 
51 +4 000 PUSHL Ri 3 
3 50 000 MOVL 0 5 
0B AS QA 6 08 MOVZBL 1 {oeScRIP), R3 > 2746 
3 3 C BEQL : 
02 9 oC CMPB R3, #2 ; 
B 18 1 BLEQU ; 
7E 00G 8F 9A 13 1$: MOVZBL #BASSK_ONEOR_TWO, -(SP) ; 


F 5 
BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 Pa 1 
(BASS 13-88-1388. TH 609 YBASRTL SRE BASvIRTOA-BS2:1 oe 48} 
000000006 00 01 F 17 CALLS #1, BASS$$STOP : 
6 02 A> i i 2s: CAPE (DESCRIP), rT) + 2752 
18 02 as 9 CMPB g{DESCRIP), #24 t 2754 
OA 1 8 BNEQ $ : 
57 e A p A MOVL 4(DESCRIP), TEMP_DESCRIP : 2761 
06 2 a7 5 CAPS (TEMP DESCRIP), 73 + 2762 
7 006 8F 9A 4 3$ MOVZBL M#BASSK_ARGDONMAT, -(SP) t 2768 
000000006 0 1 re CALLS #1, BASS$STOP : 
05 OA A E . F 4$ BBC #6, 1O(DESCRIP), 5$ + 277% 
OA AS 95 9 44 TSTB  10(DESCRIP) ; 
B 19 00047 BLSS 6 : 
7 006 BF 9A 00049 S$: MOVZBL #BASSK_ARGDONMAT, =(SP) : 
000000006 0 1 FB 00040 CALLS #1, BASSSSTOP : | 
08 AE 16 AS 9E 0094 6$: MOV g (r5) MULTIPLIERS t 2776 
5 14 A543 DE 00059 MOVAL (DESERIPIERS ‘ BOUNDS + 2777 
oc OA A 93 E1 00056 BBC #5, 10(DESCRIP), 7$ : 2783. 
51 09 006 MOVL 3, LOW INDEX : 786 
50 4 DO 00066 MOVL #1, HIGR_INDEX 3; 278 
04 AE 1 cE 0069 MNEGL #1, INDER_INCR 3 2788) 
OA 11 00060 R 8$ : 2783) 
51 1 00 O06F 7$: MOVL #1, LOW_INDEX : 2792 | 
50 53 pO 000 é MOVL R3, HIGA_INDEX 3: 2793. 
04 AE 01 09 007 MOVL #1, INDER_INCR : 2794 
54 51 04 ae 0079 8$: SUBL3 INDEX_INCR, LOW_INDEX, INDEX_NUMBER > 2797 | 
53 D4 0007E CLRL. ~~ VALUE Locat io ; 2801 
Oc AE 04 BE4O 3 00080 WOVAB @INDER_INCRCHIGH_INDEX], 12(SP) + 2803 
54 04 AE CO 00086 9$ ADDL INDEX_INCR INDER NUMBER 3 
oc AE 34 D1 0008A CMPL  INDEXTNUMBER, 12(SP) : 
A 13 OO8E BEQL 148 ; 
01 54 D1 000 CMPL INDEX NUMBER, # + 2805 
05 iF 0093 BNEQ 0$ 3 
oT of D 90095 MOVL § INDEX1, INDEX_VALUE : 
03 11 00098 BRB 11$ : 
58 52 00 009A 10$:  MOVL  INDEX2, INDEX VALUE : 
50 54 gi 8 0009D 11$:  ASHL #1, INDEX NUMBER R + 2807 
FB A640 8 D1 OO0Al CMPL INDEX. VALOE , -8 (BOUNDS) CROJ 3 
07 19 000A6 BLSS 2$ F 
FC A640 8 D1 000A8 CMPL INDEX. VALUE, -4 (BOUNDS) CROJ : 2808 
08 15 000AD BLE 45 ; 
7E 006 8F 9A OOOAF 12$:  MOVZBL #BASSK SUBOUTRAN, =(SP) > 2810 
000000006 00 oi FB 00083 CALLS #1, BASS$STOP ; 
51 08 AF 4 C3 OOOBA 13$:  §$SUBL3 #4, MULTIPLIERS, R1 + 2812 
30 5 6144 ¢5 000BF MULL3 (RI)CINDEX NUMBER], VALUE_LOCATION, RO ; 
5 50 58 ¢1 000C4 ADDL NDEX_VALUE, RO, VALUE_LOCATION 3 
ac 11 000¢8 BRB + 2803 
50 $ 3¢ OOCA 14$: MOVZWL (DESCRIP), RO > 2815 
20 C4 000C MULL2 VALUE LOCATION, RO ; 
53 0 10 A ¢ 0 ADDLS 16(DESCRIP), RO, VALUE_LOCATION F 
1 02 ad 91 9p CMPB @{DESCRIP), #24 > 2816 
07 1 09 BNEQ 5$ ; 
57 3 D 08 VL VALUE_LOCATION, TEMP_DESCRIP + 2823 
3 046 A p D MOVL 4(TEMP_DESCRIPS, VALOE_LOCATION 7 2824 
BF OF 03 AS 1 000E2 15$: CMPB $(DESCRIP), nigoi : 2831. 
17 12 OO0E BNEQ 6$ ; | 
10 AE D4 O00E9 CLRL VALUE : 2838 


- 
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i885 é Ve-$ep-1986 41:50:66 EBASRTL SRETBASVIRTUA.BS2:1 9° 485 
10 AE 9F QODEC PUSHAB VALUE ; 2839 

DD QOOEF PUSHL VALUE LOCATION ; 
DD O00F} PUSHL DESCR : | 

000000006 990 FB QOOF CALLS #3, BASSSVA_FETCH : 
10 AE DO O0FA MOVE VALUE, RO ; 2840, 
04 03 AS 91 00100 168: CPB -$(DESCRIPD, ; 2843 

B 13 001 Beal is ; 
? 006 8F 9A 001 MOVZBL #BASSK NOTIMP, -(SP) ; | 
000000006 1 £B OO10A CALLS $$STOP : | 
63 98 00111 178:  CVTB (VALUE, LOCATION), RO > 2848 
E 14 CO 00114 188: ADDL #20, SP 3.2842) 
117 $B ; | 


; Routine Size: 280 bytes, Routine Base: _BASSCODE + 1228 


H 5 
= tens eae eeaciiaohiuieta sath tttanble ia.882:1 Pa9e 48) 


695 GLOBAL ROUTINE BA sore FA_G FR ( ' Fet g floating 

6 DESCRIP : F BLOCK"C8, BYTE), i The: descFiptor, to fetch from 
69 INDEX], ' First index 

$98 INDEX2 ! Second index 

$99 ) : VA_JSB NOVALUE = 


eo 


i FUNCTIONAL DESCRIPTION: 


ANN 

Oooo 

wr 
(0D C9 CD CD. CD C0 CD CD. CD CD. 0D 0D C9. GD. 0D 0D 
PEELS OSIM 


QS ad Gar > Doe aor reece 


ROUTINE VALUE: 
COMPLETION CODES: 


The g floating number from the array or virtual array 
SIDE EFFECTS: 
Signals if an error is encountered. 


f : Fetch a g floating number from an array or virtual array. 
, FORMAL PARAMETERS: 
708 PESSRIP ec -rd.da The descriptor of the array or virtual array 
709 rl.v The first index into the array 
at ; INDEX2.rl.v The second index into the array 
ne 86 IMPLICIT INPUTS: 
71 8 
714 8 NONE 
715 8 
716 8 IMPLICIT OUTPUTS: 
717 8 
718 8 NONE 
719 8 
8 
8 
8 
8 
8 


20000 000D 
09090908 NI NINN NINN NNO OO 
DONO ULSWN —O OONOULSWN OOM 


OUNDS : REF VECTO 


890 MULTIPLIERS : REF VECTOR. 
1 LOW_INDEX, 
7 8 : HIGA_INDEX, 
738 : INDER_INCR 
7 4 VALUE ~LOCATION, 
740 895 INDEX” VALUE 
741 NDE ER 


CoCo 
oo 


3 
Se Vs 
PRaPOPaPoPEPINIPPONINIPINPPUNINNONYIDINIADD 8 8 a tt tt tt tt ot tt 
@ 
nm 
i) 
= 
2 


VALUE~: VECTOR C 
TEMP_ DESCRIP: att Ag ockt. BYTE); 

'¢ 

5 be sure the array has at least one but no more than two dimensions. 


S333 


wn 


IF ((. DESCRIP CDOSC$B_DIMCT) LSSU 1) OR (.DESCRIP CDSCSB_DIMCT] GTRU 2)) THEN BASSS$STOP (BASSK_ONEOR_TWO) 


Lins 
 $r09 
; 720 
; 721 : 
: 138 
3 4 2 
8 2 
; 2 
: 2 
: 2 
; 3 


ee! 

eae 

UMEWN—O 
RIPDPIPIPIPININIPININININIPINPININININIPININY 
Go. 00 00 Co G0 Co 

oouoo +t -F 


Sz 


ws 


— 1s age 1:86:46 UBASRtL*SRESaaSvYRiUA.682:1 16) 


= sure this array or virtual array holds g floating numbers. 


ie ‘ -DESCRIP CDSCSB_DTYPE] NEQU DSCSK_DTYPE_G) 
mE -DESCRIP COSCSB_DTYPE) EQLU DSCS$K_DTYPE_DSC) 
” 


_Special handling for dynamically mapped arrays. 
BEGIN 


TEMP _DESCRIP = .DESCRIP COSCSA_POINTER); 
IF (TTEMP_DESCRIP COSC$B_DTYPE] NEQU DSCS$K_DTYPE_G) 


BASSSSTOP (BAS$K_ARGDONMAT) ; 
se 
SE eASSSSTOP (BASSK_ARGDONMAT) ; 


i “the coefficients and bounds must be present 
IF ( NOT (,DESCRIP CDSCS$V_FL_COEFF] AND ' 
.DESCRIP CDSC$V _FL_BOONDS))) 


ke 

& 

3 

THEN 

hee BASSSSTOP (BASS$K_ARGDONMAT) ; 


78 MULTIPLIERS = DESCRIP CDSC$L_M1); 

nt BOUNDS = DESCRIP CDSC$L_M1) # (ZUPVAL*® DESCRIP CDSC$B_DIMCT)); 
785 i "tecnete the lower and upper index numbers based on how the array 
786 i is stored. 

787 

88 


ro -DESCRIP COSC$V_FL_COLUMN)) 


=_.DESCRIP COSC$B_DIMCT); 


PPP) 
SERESN= 
as 
an” 
— 
aS 
ee 


NDEX = 1; 
rit wee = ,DESCRIP COSCS$B_DIMCT); 
pee ER_I = 1; 
END 
INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
_Compute the Linear index from the indices provided. 
VALUE_LOCATION = 0; 


VAAN 


SSN SANG 
ONAN SNS 
SOOONOUSE — VPwr 
RIPIPIPIPIMININIMINININININIHNININIAIPPINPIADINIPYAIPIPINININININIMININIPININIPIPINIPIPIPIPIPIPIPIPIPIPIPOPOPPONNPD 
DODOOVOVO OVO OOOO O OOOO OVOO OOOO ODOOVOVOOVOOOVOOOVOOVOVOVOVOVOOOOOWOOO 
BREE EEE SE & FAWN III WI PIPINININIPONINIDY) 2 2 OO 
DWONOA UE WN 0 OONOAUN EWN OO OOVNOU SW OO COVNOU EW O —~ 


SESS 


: 2781 


WO OOVNOUSWIN © 


SeSSr once seseahas sess 
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Assy 12nep-13be 9}i88icg || He Xsat oSaeSeagvintuaoS2:1 39° 16) 


NDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_ INDEX * .INDEX_INCR)) DO 
VALUE = CIF (. INDEX NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 
- INDEX VALUE LSS .BOUNDS C(.INDEX NUMBER = 1)#2]) |! 


| WHIL 
nen” (,INBEX_VALUE GTR .BOUNDS C((.IRDEX_NUMBER = 1)*2) + 1))) 
BASSSSTOP (BASS$K_SUBOUTRAN) ; 
4 
4 
4 
4 
4 
4 
4 
4 


SOOOE 


OOONOMNES WN "OOOO 


I 
N 
x 
( 


Fae Ue LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 


(, VALUE _LOCATION*.DESCRI 


VALUE tye ey ~ P COSC$W_LENGTH]) + .DESCRIP CDSC$A_A0); 
IF ,DEScRIP DSC$B_DTYPEJ EQLU DSC$K_DTYPE_DSC 


oni "special handling for dynamically mapped arrays. 
BEGIN 
TEMP DESCRIP = .VALUE_LOCATION; 
VALUE_LOCATION = .TEMP_DESCRIP CDSCSA_POINTER); 

' END; 


°¢ 
Special handling for virtual arrays. 
i] 


esas 


IF (DESCRIP CDSCSB_CLASS] EQLU DSCSK_CLASS_BFA) 


Ww 


BEGIN 
earn (.DESCRIP, .VALUE_LOCATION, VALUE); 


REGISTER 
RO = 0, 

R1 = 1; 

| 

RO = .VALUE £03; 

R1 = [VALUE (1): | 

RETURN; 


E 
END; 
IF (.DESCRIP COSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$STOP (BASSK_NOTIMP); 


© Be Se Se Ge Ge Se Ge Se Ge Se Se Ge Ge Ge Ge Ge Ge Ge Ge Ge Se Ge oe Se 
rmorornor 


hieteteteteteteteiet tat tt ot tt 
SOOONOUSWN OO 


Return the array element as our value. 
BEGIN 
REGISTER 
RO = OQ, 
R1 = 1; 


BASSSCOPY 
RO = .VAL 


—OOOnOuluwnr— 


3 3 


Be Be Oe Oe Be Be Oe Be Oe Be Oe Se Se Se Be Se Os Se Se Ge Ge Ge Ss Be Ge SF Se Oe SF Se Se Se Se Os Os Os OF Ge Se Os Oe Ss Os Oe HOF ws OF Ss SFOs Se Fes Sears 
PUPUROPORGS 
AMINA ROR RRORIRIRIRS Sos te toa 
WARIPIPIPOPININPUNINIDS 2 9 PO OO OO Oe 
SCOWONOVSWN “OC ODONOUS WIN" 
POPIPIPININPIPINIPIPINPIPIPOPININIPYAINIPININPINNPININININPIPIPYININPY 
OOOOODOOOVOOOOOOO 
Poke ONAN NNO 


Soooooooooeoeso 
SOOWONOUS WOO 


Py ae ee te 


G_R1_(.VALUE_LOCATION, VALUE); 
0E~(0); 
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BASS ereee= tS Re Phi88ice «| FANSAT Obhesa Re Reon 7680.4 ge 86 
R1 = .VALUE (1); 
ow 
END; ! end of BASSFET_FA_G_R8 
SE 14 C2 00000 BASSFET_FA_G_RB:: | 
“SUBL2 #20, SP : 2850 
1 0D 0003 PUSHL 1 : | 
54 0 D0 00 OVL RO, R4 ; 
53 0B A4 9A 00008 MOVZBL 11(DESCRIP), R3 + 2904 
§ 13 0000C BEQL  1$ : 
02 3 91 0000E CMPBeéR3, #2 : 
7E 006 ? 38 tte 1$ SOU TBL $BA S$K_ONEOR_TWO, -(SP) ' 
000000006 00 01 FB 00017 CALLS #1, BAS$$STOP : 
18 02 A& 91 OOOIE 28 CMPB = 2(DESCRIP), #27 + 2910 
1B 13 00022 BEQL 46 4$ ; 
18 02 Aa 91 00 4 CMPB g(DESCRIP), #24 + 2912 
OA 12 00028 BNEQ $ ; 
56 04 A& DO OO02A MOVL 4 (DESCRIP), TEMP -DESCRIP $ 2919) 
18 02 Ab 91 000 E CMPB =. 2 TEMP_DESCRIP), + 2920 
0B 13 000 BEQL 4$ ; 
7E 006 BF 9A 00034 3$ MOVZBL #BA ASSK ARGDONMAT, =(SP) t 2926 
000000006 00 01 FB 00038 CALLS #1, BASS$STO ; | 
5 OA AG 06 Fl 0003F 4$ BBC #6. TOCDESCRIPD, 5$ ; 2932 
OA Ad 95 00044 TSTB  10(DESCRIP) : 2933, 
0B 19 00047 BLSS 6$ ; 
7E 006 8F 9A 00049 S$: MOVZBL #BASS$K_ARGDONMAT, -(SP) : 2935 
000000006 00 01 FB 0004D CALLS #1, BASSS$STOP ; 
08 AE 14 A& YE 00054 6$ V gina) MULTIPLIER + 2937 
5 14 A443 DE 00059 MOVAL OCDESERIPIERS ; Buns : 2938 | 
0c OA Ab 05 €1 00056 C #5, 10(DESCRIP). 7$ + 2944 | 
51 53 DO 0006 MOVL  R3, LOW_INDEX + 2947 
50 01 DO 00066 VL #1, HIGA_INDEX + 2948 
04 AE 01 CE 00069 MNEGL #1, INDER_INCR + 2949 
0A 11 0006D 8 as + 2944 
51 01 DO O006F 7$ MOVL #1, LOW_INDEX 3 2953 | 
50 3 D0 0072 MOVL 3, HIGA_INDEX > 2954 | 
04 AE 01 D9 007 MOVL. #1. INDER_INCR : 2955 
53 51 04 AE 0079 8$ SUBL3 INDEX_INCR, LOW_INDEX, INDEX_NUMBER > 2958 | 
5 pA 0 43 CLRL. VALUE incre : 296 
0c AF 04 BE4O F 008 ROVAB @INDER_INCR HIGH INDEX 12(SP) + 2964 
5 AE C 0086 9$ ADDL INDEX, TNC NDERN UMBER ; 
Oc AE bt O8A CMPL INDEX= nunsér. 1 (spy ; 
A 13 0008 BEQL 4$ 3 
01 3 pi 000 CMPL INDEX. NUMBER, #1 + 2966 | 
05 if 009 BNEO 0$ ; 
58 D 009 MOVL {NDEXT, INDEX_VALUE 3 
0 S098 10$ BOVE INDEX2 INDEX, VALUE | : 
50 3g p a 8090 11$: ASHL #1, IN Sse" UMBER : 2968 | 
FB A540 8 pi OAl CMPL INBEX x VALOE, gocuds) CRO? ; 
07 19 0006 BLSS 2$ : 


BASSVIRTUAL_ARR 
= 
FC A540 38 
43 006 8F 
aaees ’ \y 0 1 
24 . 5 gie3 
29 50 58 
BC 
50 $s 
50 7 
57 50 10 AG 
18 02 Ad 
oF 
56 7 
57 04 Ab 
BF 8F 03 AG 
10 
10 AE 
0090 =BF 
000000006 00 93 
04 03 AG 
0B 
7E 00G 8F 
00000000G 00 01 
51 10 ag 
50 5 
000000006 00 
50 10 AE 
5E 18 
; Routine Size: 287 bytes, Routine Base: _BASSCODE + 


; 2870 3025 1 


COON 9 ONO O- "DO OTD 9 SONNE NOO TO" 9 
— MNOVIOOMD® PW DD MPN" OONR) 2 HS FO Sa Pa 


—— 
or 


COOQOooooooooooooooooooooooooooooe 
COOOCCCCOCOCOCOOSOOCOCOOOCOOOOOSOOOOOOOOOoOOoOO 
3S 2 OOO NNR MMMMMOCVIVVIOPOOO@WW>r>r> 


MONO PWS ONOM ONNIMD OWS FOL Pwo 


343 


ee 
wm 
eaow 
vo0vm 
te 
——> 
woo 
@oo 


15$: 


16$: 


17$: 


18$: 


AX-11 Bliss-32 V4.0-7 
BASRTL.SRCIJBASVIRTUA. : 2:1 


{ DEX_VALUE, -4(BOUNDS)CROJ 
#BASSK_SUBOUTRAN, -(SP) 
ai. Basessrop 

BUC TIPLIER 


CR CONDE AERGERS VALUE_LOCATION, RO 
paste RO, VALUE_LOCATION 


R au LOCATION 


Oy 

"#24 

ION, TEMP_DESCRIP 
RIP VALOE_LOCATION 


VALUE | 
#OM<RG 
es BASSSVA_ FETCH 


ZsSESCRIPD. ay 


#BASSK NOT IMP, 
#1, BASS$STO 
VALUE, R1 
VALUELOCATION, RO 
BASSSCOPY_G_R1 
VALU 


-(SP) 


- 
oe 
e 


Page 87 


(16) 
2969 
2971, 
2973 


Lar ] 
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1o7808- 1382 OF 8Ri2g SSATL SAE IBASVIRTUA. B42: . a8 
; 0 $ 1 GLOBAL wy PF BASSFET_FA Re ( ! Fetch anh teasing 

: 0 1 DES ue : REF BLOCK"C8, BYTE), ' The descriptor to fetch from 

3 8 8 1 INDEX1, ' First index 

: 1 INDEX2 ' Second index 

; 4 » ! ) : VA_JSB NOVALUE = 

; 0 § 1 !e¢ 
: 8 ? ! FUNCTIONAL DESCRIPTION: 
3 b3? ! } Fetch an h floating number from an array or virtual array. 
H tHE } FORMAL PARAMETERS: 
3 039 1! DESCRIP.rd.da The descriptor of the array or virtual array 
3 040 1! INDEX1.rl.v The first index into the array 
3 shes : } INDEX2.rl.v The second index into the array | 
3 3028 1 ! IMPLICIT INPUTS: 
3 3045 1! NONE 
; 3046 1! | 
; $006 1 ! IMPLICIT OUTPUTS: 
3 048 1! 
3 3049 1! NONE 
3 3050 1! 
3 3051 1 ! ROUTINE VALUE: 
3 3028 ' COMPLETION CODES: 
3 so2e ! The h floating number from the array or virtual array 
3 3056 1 ! SIDE EFFECTS: 
3 3057 1! 
3 3058 1! Signals if an error is encountered. 
; 3059 1! 
3 3060 1 !-- 
; 3061 1 
H $008 BEGIN 
3 06 
3; 2910 064 LOCAL 
3; 2911 065 BOUNDS : REF VECTOR 
i: 9te 066 MULTIPLIERS : REF VECTOR, | 
3; 291 Ht LOW INDEX, 
3 2914 068 I1GA_INDEX, 
> 2915 069 INDER_INCR 
: 3916 070 VALUE "LOCATION, 
3: 291 071 INDEX_VALU 
3; 2918 $376 INDE X_NUMBE 
> 2919 307 VALUE”: VECTOR [4] 
> 2920 074 TEMP_DESCRIP: REF BLOCK BYTE); | 
3: 2921 075 

3 29 § b76 '¢ ‘ : 
3 ; ? 344 : Be sure the array has at least one but no more than two dimensions. 
: 2925 079 

; s A IF ((, DESCRIP CDSC$B_DIMCT] LSSU 1) OR (.DESCRIP COSCS$B_DIMCT] GTRU 2)) THEN BASS$S$STOP (BASSK_ONEOR_TWO) | 
: 2928 082 '¢ 


PAS EY TA TUAL Aan 16- sep-1984 9: 9:44 AX-11 BLi atiea 32 V 


Page 89 
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: 8 Be sure this array or virtual array holds h floating numbers. 

: 2931 085 2. 

3 29 ‘ 0 § IF (.DESCRIP CDSC$B_DTYPE NEQU DSC$K_DTYPE_H) 

3 29 08 THEN 

> 2934 088 IF (DESCRIP CDSCSB_DTYPE] EQLU DSC$K_DTYPE_DSC) 

Be aa 

; STA Ba) Special handling for dynamically mapped arrays. 

ee: ssn 

> 2941 095 TEMP. DESCRIP = .DESCRIP CDSC$A_POINTER); 

; 3% 096 4 IF (TTEMP_DESCRIP COSC$B_DTYPE] NEQU DSC$K_DTYPE_H) | 
> 2944 098 BASSSSTOP (BAS$K_ARGDONMAT); | 
> 2945 3099 
: $328 3109 evsee | 
> 2948 3102 BASSS$STOP (BAS$K_ARGDONMAT); | 
Be HEE. 
+ 2951 3108 i The coefficients and bounds must be present 
Be BBE 
: $982 3108 4 IF ( NOT (.DESCRIP COSC$V_FL_COEFF] AND ' | 
; $92 3108 3 .DESCRIP CDSC$V_FL_BOONDS))) | 
; 2957 3111 2 BASSSSTOP (BASSK_ARGDONMAT); 
; $959 3118 3 MULTIPLIERS = DESCRIP CDSC$L_M1); 

; 2960 3116 = BOUNDS = DESCRIP CDSC$L_M1) * (ZUPVAL*®.DESCRIP CDSC$B_DIMCT)); | 
; 3434 3116 i Compute the lower and upper index numbers based on how the array 
3 $36 3117 _is stored. 
Be HM 
: 2366 3120 3 IF (.DESCRIP COSCSV_FL_COLUMN)) 
: $367 3152 § MMe | 
: 2969 315 3 LOW INDEX = .DESCRIP CDSC$B_DIMCTI; 

3: 2970 3124 HIGR_INDEX = 1; 

+ 2971 125 INDER_INCR = -1; 

3 16 ° 

> 297% 128 BEGIN 

: 2975 3198 OW INDEX = 1; 

+ 2976 130 3 HIGA_INDEX = .DESCRIP CDSC$B_DIMCT); 

+ 2977 131 INDER_INCR = 1; 

: $975 138 ; 

; 980 4 _._ INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

: 4 136 Compute the Linear index from the indices provided. 

: 2984 133 VALUE_LOCATION = 0; 

> 2985 139 


8 6 
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WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_ INDEX + .INDEX_INCR)) DO 
INDEX VALUE = (IF (. INDEX NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


IF ((, INDEX VALUE LSS .BOUNDS C(.INDEX NUMBER = 1)*#2]) ! 
OR (.INDEX_VALUE GTR .BOUNDS C((.INDEX_NUMBER - 1)*2) + 1])) 


THEN 
BASS$STOP (BAS$K_SUBOUTRAN) ; 
a amcerteatt = (.VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 


998 (. VALUE _LOCATION® .DESCRI 


VALUE_LOCATION = P (0 
CDSCSB_DTYPEJ EQLU DSC$K_DTYPE_DS 


SC$W_LENGTH]) + .DESCRIP CDSC$A_A0]; 
iF gDescRiP C 


14 
Special handling for dynamically mapped arrays. 
BEGIN 


TEMP DESCRIP = .VALUE_ LOCATION; 
VALUE_LOCATION = .TEMP_DESCRIP COSCSA_POINTER); 


gesee3 


33 


on 
MEN — O ODNAUES WN (OOD NAUES WN O ODNAUS ARO OONOUS WO 


ooo 


'¢ 
Return the array element as our value. 


009 END; 
010 '¢ 
O12 Special handling for virtual arrays. 
01 
014 IF (.DESCRIP CDSCS$B_CLASS] EQLU DSCSK_CLASS_BFA) 
015 THEN 
016 BEGIN 
017 BASSSVA_FETCH (.DESCRIP, .VALUE_LOCATION, VALUE); 
018 BEGIN 
019 
020 REGISTER 
ps) RO = 0, 
0 ¢ R1 = 1, 
02 R2 = ¢: 
024 R3 = 3; 
025 
ose RO = .VALUE (0); 
028 Re = ,VALUE $3: 
Oe? R3 = .VALUE (3); 
030 RETURN; 
031 END; 
033 7 — 
$e : IF (.DESCRIP CDSCS$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASSSSTOP (BASSK_NOTIMP); 
Hy 
35 


ooo 


BEGIN 
REGISTER 
RO = 0 


MrPwn— 
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_ BASSVIRTUAL_ARR 1$- $ep-1984 01:29:44 AX-11 Bliss-32 v4.0- Pp 1 
085 1e=Sep=1986 11:50:46 EBASRTL SRESBASVIRTUA. B82: 1 29° 15) 
im oh ve 
'f 3048 199 a : : 
; 046 00 
3 ee 01 BASSSCORY 4 f3, (.VALUE_LOCATION, VALUE); 
; 3048 0¢ RO = .VALOE~[0); 
: 30469 0 Ri = er | 1): 
; 3050 04 R2 = .VALUE ; ; 
: 091 05 RS = VALUE ; 
3 088 $$ ND; 
; 3054 08 END; ! end of BASSFET_FA_H_R8 
SE 1€ C2 00000 BASSFET_FA_H_RS:: 
“SUBL2 #28, SP : 3026 
DD 00003 PUSHL : 
54 50 DO 00005 MOVL RO, : 
53 0B AG OA 60008 MOV ZBL TT iDESCRIP), R3 : 3080 
05 13 0000C BEQL ss : 
02 53 91 0000E CMPB OS séR3, #2 : 
0B 18 00011 BLEQU 28 : 
7E 006 8F 9A 90013 1$: MOVZBL #BASSK ONEOR TwO, -(SP) : 
000000006 06 01 FB 0001 CALLS BASSSSTOP ; 
1C 02 Ad 91 OOOIE 28: CMPB x bESCRIPS. #28 > 3086 
18 13 00022 BEQL = 4 : 
18 02 A 91 00 4 CMPB (DESCRIP), #24 : 3088 
OA 12 00028 BNEQ $ F 
56 06 Ad 0O 999 A MOVL  4(DESCRIP), TEMP_DESCRIP : 3095 
iC 02 a6 91 000 ; CMPB =. 2( TEMP_DESCRIP) , “#28 : 3096 
0B 13 000 BEQL «6s 4$ : 
7E 006 8F 9A 00034 3$ MOVZBL #BASSK_ARGDONMAT, -(SP) : 3102 
000000006 00 01 FB 00038 CALLS #1, BASS : 
5 OA AG 06 3 O003F 4$ BBC tt TOCDESCRIPD, 5$ : 3108 
OA A& 95 00044 TSTB =: 10DESCRI : 3109 
0B 19 00047 BLSS ; 
7E 006 8F 9A 00049 S$: MOVZBL OBA ASSK_ARGDONMAT, -(SP) > 3111 
000000006 00 01 FB 00040 CALLS #1, BASSSST ; 
08 A 4 Ad YE 00054 68: MOVAB g0iRd) MULTIP ERS > 3113 
14 A643 DE 00059 MOVAL (DESCRIP)CR3 OUND $ > 3114 
0c OA Ab 93 E1 0055 BBC a5, GSthescnte)” : 31 9 
51 DO 0006 MOVL * LOW INDEX : 31 
50 4 dO se: MOVL #1, HIGA_INDEX : 3124 
046 AE 1 cE 006 MNEGL #1, INDER_INCR > 3125 
OA 1 9060 BRB 8$ : 3120 
51 ot D0 6f 7$: MOVL #1, LOW_INDEX : 3129 
50 3 p00 000 é MOVL R3, HIGA_ INDEX : 3130 
04 AE 01 00 0007 VL #1, INDER_INCR : 3131 
53 51 4 AE C 0079 8$: SUBL3 INDEX x INCR. LOW_INDEX, INDEX NUMBER : 31 
5 pA 007 CLRL. VALUE ~LOCATIO > 3138 
0c af o% BE4O 3 00 MOV @INDER INCR fhe INDEX], 12(SP) : 3140 
5 AF C 99 9$ ADDL INDEX =p NUMBER ; 
Oc «AE } D1 OO008A CMPL INDEX nunaér. 12(SP) ; 
A 13 O008E BEQL 4$ ; 


ace Uindabalne 


dD 6 
BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 v4.0-74 Page 92 
4 BAS 13-38-38 1:56:46 YBASRTL” SRC IJBASVIRTUA.B32;1 . as 
01 1 CMPL NDEX_NUMBER, #1 3 3142 
| 38 ° 038 BNEQ 0$ : 
58 D 9 MOVL NDEX1, INDEX_VALUE : 
30 BOO9R 108: por.  fubexe INDEX, VALUE : 
50 ; 9 08 90 115 ASHL #1, _INDEX UMBER + 3144 
FB ASG g D1 al CPL inex, at {bounds CRO : 
FC A540 53 b GOB cHPL INDEX, VALUE, =-4(BOUNDS)(ROJ + 3145 
7E 006 8F 9A OOOAF 12S: MOVZBL aA ASSK SUBOUTRAN, -(SP) + 3147 
000000096 00 ; F 0085 CALL , BASSS : 
51 0 AE 4 ¢ BA 13$ SUBL RULTIPLIE : 3149 
29 5 6143 ¢5 000BF MULL n: Pitas, VALUE_LOCATION, RO : 
7 50 58 C1 000C4 ADDL IN ob IYALUE. RO, VALUE LOCATION : 
Bc 11 000C8 BRB $ : 3140 
50 64 3C OOOCA 148 MOVZWL (DESCRIP), RO : 3152 
50 7 (4 000COD MULL2 VALUE LOCATION ; 
57 50 10 AG a 9000 ADDL3 16(DESCRIP), RO, au _LOCATION : 
18 02 A& 91 0000 CMPB SDESCRIPD #24 + 3153 
97 12 90009 BNEQ 15$ : 
66 7 00 000D8 MOVL §_VALUE_LOCATION, TEMP_DESCRIP : 3160 
57 04 A6 DO 0000 MOVL  4(TEMP DESCRIP), VALOE_LOCATION + 3161 
BF BF 03 Ad 91 OO0E2 15$: CMPB 40s 3(DESCRIP), #194 : 3168 
10 12 OO0E BNEQ =16$ : 
10 AE 9F OOOE9 PUSHAB VALUE | + 3171 
0090 8F 6B OOOEC PUSHR #*M<R4,R7 : 
000000006 00 03 FB 000FO CALLS #3, BASSSVA_FETCH : 
1E 11 000F7 BRB : 3180 
04 03 Ad 91 O000F9 168: CMPB 3(DESCRIP), #4 : 3188 
B 13 OO0GFD BEQL «si7$ ; 
7E 006 8F 9A OOOFF MOVZBL HBASSK NOT IMP. -(SP) F 
000000006 00 01 FB 00103 CALLS , BASSS : 
51 10 Ag 9 0010A 17$: MOVAB 44 CUE, + i : 3201 
50 57 DO 0010€ MOVL =~ VALUE LOCATION, RO ; 
000000006 00 16 00111 JSB BASSSCOPY_H_R3 F 
50 10 AE 7D 00117 18$: §MOVQ VALUE, : 3202 
52 18 AE 7D 00118 MOva VALUE $8. R2 + 3204 
SE 20 CO O011F ADDL2 : 3208 
05 00122 RSB F 
; Routine Size: 291 bytes, Routine Base: _BASSCODE + 1462 


; 3055 3209 1 


6 
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2835 oi 14-Sep=1 Be i 6:46 BASRTL. SRC IBASVIRTUA 82:1 ’ 
$ 


Sy 
; 3057 19 1 GLOBAL ROUTINE BASSSTO_FA_B_RB ( ' Store a byte 
; 30 5 } VALU ' The value to store 
; 30 \¢ 1 DESCRIP : REF BLOCK (8, BYTE), ' The descriptor to store into 
; 3060 im INDEX1, ' First index 
; 53061 14 «1 INDEX ' Second index 
3 p66 18 1 ) : VA_JSB NOVALUE = 
; 306 1g 1 
3; 35064 1 1 le4 
3; 3065 1 1 ! FUNCTIONAL DESCRIPTION: 
3; 3066 19 1! 
; 6d Y : } Store a byte in an array or virtual array. 
; 069 2 1 | FORMAL PARAMETERS: 
3; 3070 § 1! 
3; 3071 me VALUE. rb.v The value to store 
3 Ore ~~: DESCRIP.rw.da The descriptor of the array or virtual array 
3; 307 § 1! INDEX1.rl.v The first index into the array 
; Bre } INDEX2.rl.v The second index into the array 
: 3076 9 1! IMPLICIT INPUTS: 
3; 3077 01! 
3 aS 1 ! NONE 
; 3080 : 1} IMPLICIT OUTPUTS: 
3; 3081 . 23 
3; 308 35 1! NONE 
3; 3508 36 1! 
3; 3084 37 1 ! ROUTINE VALUE: 
3; 3085 38 1 ! COMPLETION CODES: 
3; 3086 39 1! 
3; 3087 40 1! NONE 
3 3088 $244 1! 
3; 3089 42 1 ! SIDE EFFECTS: 
3; 3090 ss 34 
3; 3091 44 1! Signals if an error is encountered. 
; p36 45 1! 
3; 309 $38 1 !-- 
3 3094 47 1 
3; 3095 see BEGIN 
: O99 356 LOCAL 
3; 35098 51 BOUNDS : REF VECTOR 
: 3099 3 MULTIPLIERS : REF VECTOR, 
; 3100 2 LOW INDEX, 
3; 3101 4 HIGR_INDEX, 
3 108 55 INDER_INCR 
: 310 36 VALUE ~LOCATION, 
3: 3104 5 INDEX~ VALUE 
3 105 38 INDEX" NUMBER; 
: 199 60 ‘+ 
3 H+ 26¢ : Be sure the array has at least one but no more than two dimensions. 
: 3110 6 
: ut 365 IF ((. DESCRIP COSCS$B_DIMCT] LSSU 1) OR (.DESCRIP COSC$B_DIMCT] GTRU 2)) THEN BASSSSTOP (BASSK_ONEOR_ TWO) 
: 311 66 '¢ 


8 IRTUAL _ARR 16-Sep-19 4 01:29:44 Ax-11 at -32 v4.0-7 Pa 
or 1e-35b-13be 11:0:46  Basnt sResBasvinionBS2:1 ait 
: ay sure this array or virtual array holds words. 
IF (.DESCRIP CDOSCSB_DTYPE] NEQU DSCSK_DTYPE_B) THEN BASSSSTOP (BASSK_ARGDONMAT); 


“the coefficients and bounds must be present 


7 

75 

76 IF ( NOT (DESCRIP COSC$V_FL cogres AND : 

4 -DESCRIP DSC$V_FL_BOONDS))) 

73 BASSSSTOP (BASS$K_ARGDONMAT) ; 

81 MULTIPLIERS = DESCRIP CDSCSL_M1); 

: BOUNDS = DESCRIP CDSCS$L_M1]) * (ZUPVAL® DESCRIP CDSCS$B_DIMCTI); 
84 i "tenewte the lower and upper index numbers based on how the array 
85 i is stored. 

Bake 

s iV. .° DESCRIP COSC$V_FL_COLUMN]) 


HIGA_INDEX = 1; 
INDER- INER = «|; 
sett 


NDEX = 1; 

mit INDEX” = ‘DESCRIP CDSC$B _DIMCTI; 
INDER_ 1 =z 1; 
END; 

INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

i "Compute the Linear index from the indices provided. 

VALUE_LOCATION = 0; 

WHILE (CINDER NUMBER = .INDEX_ NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
INDEX VALUE = (IF (. INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


IF “ INDEX VALUE LSS .BOUNDS [C(.INDEX NUMBER = 1)#2]) =! 
a (, INDEX_VALUE GTR .BOUNDS (((.INDEX_NUMBER - 1)*2) + 1))) 


BASSSSTOP (BASSK_SUBOUTRAN) ; 
VALUE LOCATION = (.VALUE_LOCATION® MULTIPLIERS C.INDEX.NUMBER - 1) + . INDEX,VALUE; 


SSSESeSSsesesbasss 


WA. AAA AAA AAS PIPIPININININPIPINIPIPUNPIPYPDPUPIPINIPIPYPIPIPUPIPPPPoPofensny 


5 VALUE_LOCATION = (.VALUE_LOCATION® DESCRIP COSCSW_LENGTH]) + .DESCRIP CDSC$A_A0]; 
i Special handling for virtual arrays. 


NOOO DAEAQA MAMAN BBE EEE EE EUW et ee ld 


oO 1 
oO 1 
3 2 
; 31 
; 31 
3 3 
. 1 
eo 1 
3 31 
3 31 
; 31 
3 a 
= 1 
3 3 
3 3 
3 31 
3 31 
3 3 
; 31 
3; 31 
3 a 
3; 31 
3; 31 
3 av 
3; 31 
3 31 
3; 31 
; 31 
; 31 
3 31 
3; 31 
5 5 
gs 5 
3; 31 
ei. 
3; 31 
s ay 
3 31 
3 BY 
5 3 
3 3 
3 3 
: 31 
3; 31 
3 BY 
3; 31 
g 3 
3; 31 
3 3 
3; 31 
3 SY 
3; 31 
3; 31 
3 31 
3 5) 
3; 31 
3; 51 


ENBEGIN 
: LOW INDEX = .DESCRIP COSC$B_DIMCTI; 
| 


WN COCOONS wn 0 0@ 


PONORITY OO 


| BASSYIRTUAL ARR 


— a te 4 an — 2 Ss Ls ts Ys 
000909 090909 0008 NINN NINN NING 
SSF RSS sale 


Www 


Ww 


eeu 


—OODODNOVNLS WN" OVOONOuse 


08 


Yetta af 
VIRTUA.B352;1 
IF (.DESCRIP CDSCSB_CLASS] EQLU DSCSK_CLASS_BFA) 


BEGIN 
BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 


ELSE 
BEGIN 


IF (.DESCRIP COSCSB_CLASS] NEQU DSCSK_CLASS_A) THEN BASSSSTOP (BASS$K_NOTIMP); 


1+ 
Store the value provided into the array 


a C.VALUE_LOCATION, 0, 0, %BPUNIT, 1) = .VALUE; 


END; ! end of BASSSTO_FA_B_R8 
SE 10 C2 00000 BASSSTO_FA.B_RB:: 
SUBL2 #16, SP 
56 51 D0 00003 MOVL R1, R6 
OC AE 50 D0 00006 MOVL RO. VALUE 
54 0B A6 9A OODOA MOVZBL 11(DESCRIP), R4& 
05 13 0000 BEQL ssi 
02 54 91 0001 CMPB soaRG, #2 
08 1B 0001 BLEQU 2 
7E 006 8F 9A 9001 1$ MOVZBL M#BAS$K_ONEOR_TWO, -(SP) 
000000006 00 01 FB 00019 CALLS #1, BASS$S$STOP 
06 02 Ab 91 00020 28 CMPB (DESCRIP), #6 
08 13 000 4 BEQL 
7E 006 8F 9A 00026 MOVZBL #BASS$K_ARGDONMAT, -(SP) 
000000006 00 01 FB OO02A CALLS #1, BASSSSTOP 
05 OA Ab 06 3 0031 3$: BBC #6, 10(DESCRIP), 4$ 
0A A6 95 000 TSTB  10(DESCRIP) 
B 19 00039 BLSSsS5 
7E 006 8F 9A 0003B 4$: MOVZBL #BASS$K_ARGDONMAT, -(SP) 
000000006 00 01 FB 0003F CALLS #1 TO 
04 AE 14 Ab YE 00046 SS: MOVAB : (R6), MULTIPLIERS 
5 14 A644 DE 4 MOVAL (DESERIPYERS » BOUNDS 
0B OA 6 95 E 5 BBC #5, 10(DESCRIP). 6$ 
51 4 9 3 MOVL ; LOW INDEX 
50 1 0 8 MOVL #1, HIGR_INDEX 
6E 1 cE 38 MNEGL #1, INDER_INCR 
9 1 0 BRB 
51 1 00 00060 68: MOVL #1, LOW_INDEX 
50 4 D 9 MOVL R4, HIGA_INDEX 
6E 1 0 66 MOVL. #1. INDER_INCR 
55 51 gE C 69 7$: SUBL3 INDEX_INCR, LOW_INDEX, INDEX_NUMBER 
4 D4 00060 CLRL_ VALUE-LOCATION 
AE 50 6— C1 F ADDL3 INDEXTINCR, HIGH INDEX, 8(SP) 
$f CO 4 8% ADDL2  INDEX“INCR INDER NUMBER 
08 AE D1 00077 CMPL §INDEX"NUMBER, 8(SP) 
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| 
"BASSVIRTUAL_ARR 
| wrt 
| 01 
58 
50 
FB A740 
FC A740 
i 
000000006 0 
51 04 AE 
50 54 
4 $0 
50 
50 
54 50 
BF BF 


000000006 00 
04 


7E 
000000006 
E 


; Routine Size: 242 bytes, Routine Base: 
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_ 
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-BASSCODE + 1585 


[T= 
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om 
OP oe 
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AM SWIMS ONOMO OWNS FB NUM" NOOO FMT PS NVYNOOOCODW —— 
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7:29:44 AX-11 BLi atts 32 V4,0-74 
3:36:46 BASRTL.SRC BASVIR 


TUA.B52;1 


13$ 
NDEX NUMBER, #1 
{RDERT, INDEX_VALUE 
INDEX? INDEX, VALUE | 
INben Ung 
Ibex. vACOe™ tBOUNDS) CROJ 
NDEX_VALUE, -4(BOUNDS)CRO] 
Mi i ae -(SP) 
Mae 


Teescate). = 
VALUE_LOCATION, RO 
16(DESCRIP), A VALUE_LOCATION 
$(DESCR IP), #191 
VALUE 
VALUE_LOCATION 
BASS$VA_STORE 


ZeQESCRIP), as 
15$ 


ane Hy Baa -(SP) 


ATM Tohoe _LOCATION) 
He, §p 
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RASH eats rae ere a ret ee og PCR Ere oe o9e 19) 


1 4 GLOBAL ROUTINE BASSSTO_FA_G_RB ( ! Store a g floating value 

; ote . ! The value to store 

1 DESCRIP : REF BLOCK (8, BYTE), ! The descriptor to store into 
1 INDEX), ' First index 

1 INDEX2 ' Second index 

i ) : VA_JSB NOVALUE = 

1 ++ 

1 FUNCTIONAL DESCRIPTION: 


Store a 64-bit g floating value in an array or virtual array. 
FORMAL PARAMETERS: 


VALUE.rg.v The value to store 

(Passed as two longwords: VALUEO and VALUE1) 
DESCRIP.rd.da The Geece Veter of the array or virtual array 
INDEX1.rl.v The first index into the array 


PPD & & 


UE WR 0 OBNAUE WN" OOODNOULS wT 


SSSVOUNRGNLSDOVAARANASSRISA PAO O SR IRAR OLS 


! 

i 

i 

i 

i 

i 

i 

i 

i 

' 
$ 3 } INDEK2.rl.v The second index into the array 
; 36 } IMPLICIT INPUTS: 

36 $ NONE 
§ 308 ! 
$0 ' IMPLICIT OUTPUTS: 
2 re ! 
2 36 ! NONE 
2 370 ! 
2 a ' ROUTINE VALUE: 
3 38 } COMPLETION CODES: 
2 $3 ! NONE 
2 75 ‘ 
2 308 ' SIDE EFFECTS: 
2 37 ! 
2 A : Signals if an error is encountered. 
‘ 0 1 ie 
2 ; 1 
§ BEGIN 
3 38 
3 4 LOCAL 
5 OUNDS : REF VECT 


OR 
MULTIPLIERS : REF VECTOR, 


DEX” NUMBE 
VALUE™: VECTOR (2); 


'¢ 
: Put the g floating input value into a local where it will be 


PROPOPOPEPEPOPENOPIPOPIPONINONPOIS 9 ot 0 Ot 


PWAWAANA AAA NIAAA AANA 
MPOTIMONPIPOPSPININoPoPofonofony 
Secsaracs 
SSesee 


REESE 
OunFwn—o 


for 
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wie 


ww 
DONAOULSWN OO 


rorrorororrnr 


AN AINA NANI NN 


{09.9009 090000 030909 08 SIMI ININI IIN SS SUOs Or OVO OOO 


SSS 
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Mroroens 
SELESEAN=S 


oO 
wt 
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1 ~Sep-19 & i 6:46 EBASRTL-SRe BASVIRTUA. $251 9°19) 


VALUE Fo} = ,VALUEO; 
VALUE CL1J = .VALUE1; 
; Be sure the array has at least one but no more than two dimensions. 


IF ((.DESCRIP COSCSB_DIMCT] LSSU 1) OR (.DESCRIP CDSCSB_DIMCT] GTRU 2)) THEN BASSS$STOP (BASS$K_ONEOR_TWwO) 


'¢ 
Be sure this array or virtual array holds g floating values. 


IF (.DESCRIP CDSCSB_DTYPE] NEQU DSCSK_DTYPE_G) THEN BASS$STOP (BASS$K_ARGDONMAT) ; 
1+ 
: The coefficients and bounds must be present 
IF ( NOT (DESCRIP CDSCSV_FL 1 ie AND ! 
«DESCRIP CDOSC$V_FL_BODNDS})) 


BASSSSTOP (BASS$K_ARGDONMAT; ; 


MULTIPLIERS = DESCRIP COSC$L_M1); 
- BOUNDS = DESCRIP CDSCS$L_M1] * (XUPVAL*.DESCRIP CDSC$B_DIMCT)); 


i Compute the lower and upper index numbers based on how the array 
: is stored. 

IF (.DESCRIP COSC$V_FL_COLUMN)) 

THEN 


N 
LOW wre = .DESCRIP COSC$B_DIMCT); 


BE 

LOW _ INDEX = 1; 
X = ,DESCRIP COSC$B_DIMCTI; 

R_INCR = 1; 

R INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 

Compute the Linear index from the indices provided. 

" VALUE_LOCATION = 0; 

WHILE {INDEX NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
INDEX_VALUE = (IF (. INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


IF ((, INDEX VALUE LSS .BOUNDS C(. INDEX NUMBER - 1)e2)} : 
' ae (, INDEX_VALUE GTR .BOUNDS (((.IRDEX_NUMBER = 1)#2) + 1))) 


——__—— a 


K 6 
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Assy ae ets re Ser yet ee oh ean TS Oe 29° 19) 
: 3306 ‘3 BASSS$STOP (BASS$K_SUBOUTRAN); 
3 06 438 VALUE LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
: 3308 460 : 
3 08 461 VALUE_LOCATION = (.VALUE_LOCATION®.DESCRIP CDSC$W_LENGTH]) + .DESCRIP CDSC$A_AO]; 
: 11 re i Special handling for virtual arrays. 
Be eg 
: 3314 46 IF (.DESCRIP CDSC$B_CLASS] EQLU DSCS$K_CLASS_BFA) 
> 3315 46 THEN 
: 1g 466 BEGIN 
3 Vv 4 i BASSSVA_ STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 
; 36 rhe ELSE cin 
> 3321 47 
3 338 ars IF (DESCRIP CDSC$B_CLASS] NEQU DSCS$K_CLASS_A) THEN BASSS$STOP (BASSK_NOTIMP); 
: 4 47 '+ 
: 328 rs a Store the value provided into the array 
; 358 479 , BASSSCOPY_G_R1 (VALUE [0], .VALUE_LOCATION); 
; 3328 480 ; END; 
5 nH 481 
; 3330 482 1 END; ! end of BASSSTO_FA_G_R8 
SE 14 C2 00000 BASSSTO_FA_G_RB:: | 
SUBL2 #20, SP 2 3342) 
OC A 50 7D 00003 MOV  VALUEO, VALUE : 3399 | 
5 0B A2 9A 00007 MOVZBL 11(DESCRIP), RS ; 3405, 
03 13 00008 BEQL ~=s«:«1$ ; 
02 5 91 0000 CMPB RS, #2 : 
i) 1B 0019 LEQU «2 ; 
7E 006 8F 9A 00012 1$: MOVZBL #BASSK ONEOR, TwO, -(SP) ; 
000000006 00 01 FB 00016 CALLS BASSSST ; 
1B 02 a2 9 O01p 2$: CPS SiBERCRIPD. Oo ; 3411 
43 006 8F 9A 00 ; MOV ZBL ABASSK ARGDONMAT, -(SP) : 
000000006 0 1 FB 000 CALLS BASSSST ; 
5 OA A2 $ El 00 : 3$: BBC TOWEScRIP) 4$ > 3417 
OA a2 93 00 sie 19t0 tot SCRIP) ; 3418 
7E 006 BF 9A 00038 4$ MOVZBL HBASSK ARGDONMAT, -(SP) > 3420. 
000000006 00 1 £B 6 CALLS ASSSSTOP ; | 
04 AE 14 Ag 9E 00043 5$ OVAB : bir ) MULTIPLIERS : 34 ft 
ve 14 A246 DE 004 MOVAL (DESCRIP) R5J, BOUNDS > 34 
0B OA Ae } E 4 BBC #5, 1O(DESCRIP), 6$ : 3429. 
51 8 MOVL RS, LOW INDEX : 34 ¢ 
ae i? wove, SIS TASER Nie take 
9 ‘f 0058 BRB 7$° . > 3429. 


yey pee ai 


BASSVIRTUAL_ARR 1 
ASS 14-Sep-1984 
1 . 2 5D 68: MOVL 
i : 1 
55 gf 96 C 066 7$: SUBL3 
D4 OO06A CLRL 
08 AE 20 6— C1 pet ADDL 
3 CO 00071 8$ ADDL 
08 AE D1 de CMPL 
A 13 00078 BEQL 
01 5 D1 OOO7A CMPL 
5 is 007D BNEQ 
58 ; D ita MOVL 
2 11 82 BRB 
38 4 Be 0084 9$: MOVL 
50 5 01 0087 10$ ASHL 
FB A640 58 01 it CMPL 
07 19 0009 BLSS 
FC A640 58 D1 4443 CMPL 
0B 15 0009 BLEQ 
7E 00G 8F 9A 00099 11$ MOVZBL 
00000000G 00 01 Fe 00090 CALL 
50 04 ag 04 C Banas 12$ SUBL 
51 5 6045 C5 OO0OA9 MULL 
57 51 58 C1 OODAE ADDL 
BD 11 00082 BRB 
51 3 3C 00084 13$ MOVZWL 
51 57 C¢4& 00087 MULL 
57 51 10 | 3, OOOBA ADDL 
BF 8F 03 A 1 tH CMPB 
10 12 000C4 NEQ 
0c AE 9F 0C6 PUSHAB 
0084 8F BB 000C9 PUSHR 
00000000G 00 03 FB OOOCD CALLS 
is 11 00004 BRB 
04 03 A2 91 000D6 14$: CMPB 
0B 13 OOODA BEQL 
7E 00G 8F 9A OOO0DC MOVZBL 
000000006 92 01 FB Boee CALLS 
0c a 43 OOE7 15$: MOVAB 
51 5 D OOEB MOVL 
00000000G 00 16 OOOEE JSB 
5E 14 CO OOOF4 16$: ADDL2 
05 000F7 RSB 


; Routine Size: 248 bytes, Routine Base: _BASSCODE + 1677 


“Sep-1984 01:29:44 -VAX-11 B 
: Ori83icg = YaXsat® 


i tegate Yost rae 

SRCJBASVIRTUA.B32; 1 

#1, LOW_INDEX 

RS, HIGA_INDEX 

#1, _INDER_INCR 

INDEX_INCR, LOW_INDEX, INDEX_NUMBER 

VALUE -LOCATION 

INDEX"INCR, HIGH_INDEX, 8(SP) 
“INCR, INDER_NUMBER 

NDEX"NUMBER, 8(SP) 

NDEX_NUMBER, #1 


INDEX1, INDEX_VALUE 
0$ 


_ INDEX2, INDEX VALUE 


#1, INDEX_NUMBER, RO 
INBEX_VALOE. =BCGOUNDS) CROJ 
INDEX VALUE, ~4(BOUNDS) CROJ 


#BASSK_SUBOUTRAN, =(SP) 
#1, BASSSSTOP 
#4, MULTIPLIERS 


RO 
(RO) CINDEX NUMBER], VALUE_LOCATION, R1 
JNDEX_VALUE, R1, VALUE_LOTATION 


~wowz— 


(DESCRIP), R1 
VALUE_LOCATION, R1 

16(DESCRIP), R1, VALUE_LOCATION 
3(DESCRIP), #194 

14$ 

VALUE 


#°M<R2,R7> 
#3 BASSSVA_STORE 


#{DESCRIP), a4 
#BASSK_NOTIMP, -(SP) 
#1, BASSS$STOP 

VALUE, R 
VALUE_LOCATION, R1 
BASSSTOPY_G_R1 

#20, SP 


Page 1 


Pee Se Be Be Se Ge Be Se Ge Se Ge Se Ge Ge Bs Se Ge Ge Be Se Se Be Ge Be Ge Fe Se Fe Be Se Se Fe Se Ge Fe Fe Be Se Se Se Se Be 


(19) 


Mm 6 
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888 14-Sep-1 Ba Hi 6:46 EBASRTL SRE BASVIRTUABS251 


Store an h floating value 


woovown 


++ 
FUNCTIONAL DESCRIPTION: 


9 
9 
3 1 GLOBAL ROUTINE BASSSTO_FA_H_RB ( ' 
4 VALUEO, ' The value to store 
5 VALUE1, i 
§ VALU i 
VALU i 
8 DESCRIP : REF BLOCK (8, B’TE], i The descriptor to store into 
INDEX], ' First index 
0 INDEX2 ' Second index 
: ) : VA_JSB NOVALUE = 
4 
5 


oo 


Store an h floating value in an array or virtual array. 
FORMAL PARAMETERS: 

VALUE .rl.v The value to store 

(Passed as four longwords) : 

DESCRIP.rd.da The descriptor of the array or virtual array 

INDEX1.rl.v The first index into the array 

INDEX2.rl.v The second index into the array 
IMPLICIT INPUTS: 

NONE 
IMPLICIT OUTPUTS: 

NONE 


ROUTINE VALUE: 
COMPLETION CODES: 


NONE 
SIDE EFFECTS: 
Signals if an error is encountered. 


WANA AIAI NAIA AINA AIAN 
SESE SP rt oP 
WN —O OONOAUS WN “OV ODVNOVUES WN “OVDONAUF WI 


AOCOUMVIVVIMNUIVIVIUT 


AAA NAAN 


PRE ee ee ah ah sb ab dh sh sds ad al eal eal eagles eles le ele? oP oP oF oF oF oF oF? a? oF? a at et et et et ee 


Ao ade 
AWWW AIA AILAIIPINNINININININIDY 9 9 OOO | SS OOOOOCOOCOCOOOO 


CONAULSWN—OVOONOu 


BEGIN 


LOCAL 
BOUNDS : REF VECTOR 
MULTIPLIERS : REF VECTOR, 
% 


AA. ALA. A.ANAIAINAIAINIAI AINA AAAI AAW AAW 


SSNS NS 


379 


Ad AAAI AI AAA AAAI AINA AAAI 


NDE X_NUMBE 
VALUE™: VECTOR (4); 
'¢ 
! Put the h floating input value into a local where it will be 


PROPPOPONOPONONOMONOPONPOPINNY 8 at tt tt 


DONO ANEW 0 ODA EWN (OOO NAUE WN O ODNOUE WN "OC OONO 


WWWWAANAN 
sesesess 
oOnoOw 


N 6 
BASSVIRTUAL_ARR 6-Sep-1984 01:29:44 AX-11 Bliss-32 V4.0-74 
w2888 o733b-198 8:06 BASRTL SREIBASVIRTUA.B 92; 1 


89 


1+ 
Be sure the array has at least one but no more than two dimensions. 


IF ((.DESCRIP COSCSB_DIMCT] LSSU 1) OR (.DESCRIP CDSCSB_DIMCT] GTRU 2)) THEN BAS$$STOP (BAS$K_ONEOR_ TWO) 


'¢ 
Be sure this array or virtual array holds h floating values. | 


IF (.DESCRIP CDSCSB_DTYPE] NEQU DSCSK_DTYPE_H) THEN BASS$STOP (BASS$K_ARGDONMAT); | 

i 

'¢ 

The coefficients and bounds must be present 

IF ( NOT (.DESCRIP CDSC$V_FL_COEFF] AND ! 

geste? COSC$V_FL_BOONDS))) 
BASSSSTOP (BASS$K_ARGDONMAT) ; 


MULTIPLIERS = DESCRIP CDSCS$L_M1); 
re BOUNDS = DESCRIP CDSC$L_M1] * (XUPVAL*.DESCRIP CDSC$B_DIMCTI); 


i Compute the lower and upper index numbers based on how the array 
is stored. 


FUN — OC OODNOUE WN 0 OONOAUE AR SO OONOULS WN O 


IF (DESCRIP COSC$V_FL_COLUMN)) 
THEN 


; safe. 
"VALUE 0 = ,VALUEO; 
VALU = ;VALUE1; 
VALU : = {VALUE2: 
VALUE = { VALUES: 
4 
: 
3 


CODD OD SIN SSDS DD DDD DDD ITU BE 


vo 
rs 
So 
oO 
AANA. AANA AIAN AANA AINA AAAI AIAN AAAI AIA AIA 
Pw eee al al al al a al Ah dh db Ab Ab dh hb hb db db bd bed hh dbedh th db 4h dh dh dh ab dh db dh dh Ah Ah dk dd Abed ah ah dh db eh dl esa esas ea! 


re IITIIIII III III I III II III IIIS 
CNR SROROTOPURITUTUIIID = = aa a an 
WAWw 
BRAUN SSONOUEWN “OOD NOME WO 


e 
; 
? 
° 
° 
° 
° 
. 
: 
o 
° 
6 
° 
° 
e 
: 
é 
6 
e 
. 
+ 
: 
i 
: 
. 
; 


5 
6 EGI 
7 LOW INDEX = .DESCRIP CDOSC$B_DIMCT); 
8 HIGA_INDEX = 1; 
9 INDER_INCR = -1; 
0 D 
1 ) 
§ BEGIN 
: LOW INDEX = 1; 
G HIGR_INDEX = DESCRIP COSC$B_DIMCTI; 
4 85 INDER_INCR = 1; 
86 END; 
436 87 
a3? 88 , INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
rb s Compute the Linear index from the indices provided. 
red 3 VALUE_LOCATION = 0; 
rr Be WHILE (CINDEX_NUMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
3445 96 INDEX_VALUE = (IF (. INDEX_NUMBER EQL 1) THEN .INDEX1 ELSE .INDEX2); 


7 
18. -Sep-1984 91: 9:44 Ax-11 BLli degeseuie oo 
14-Sep-1984 11:56:46 BASRTL.SRCJBASVIR rie 2:1 
97 
336 3 IF (C ,NDEX VALUE LSS .BOUNDS (IN X_NUMBER = 1)#2]) ! 
239 4 oe (. INBEX_VALUE GTR .BOUNDS READER _NUMBER < 1} #2) + 1))) 
601 BASSSSTOP (BASS$K_SUBOUTRAN) ; 
608 VALUE. LOCATION = (,VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) + .INDEX_VALUE; 
605 ‘ 
606 VALUE_LOCATION = (.VALUE_LOCATION®.DESCRIP CDSCS$W_LENGTH]) + .DESCRIP CDSC$A_AO); 
eRe Special handling for virtual arrays. 
610 : 
611 IF (.DESCRIP CDSC$B_CLASS] EQLU DSC$K_CLASS_BFA) 
61¢ THEN 
61 BEGIN 
614 BASSSVA_STORE (.DESCRIP, .VALUE_LOCATION, VALUE); 
616 ELSE 
elf BEGIN 
$620 IF (.DESCRIP CDSCSB_CLASS] NEQU DSCSK_CLASS_A) THEN BASSS$STOP (BASSK_NOTIMP); 
621 '¢ 
is - Store the value provided into the array 
624 3 BASSSCOPY_H_R3 (VALUE [0], .VALUE_LOCATION); 
3625 2 END; 
3626 2 
3627 1 END: ! end of BASSSTO_FA_H_R8 
5E 1C C2 00000 BASSSTO_FA_H_RB:: 
sual 2 #28, 
OC AE 50 7D 00003 VALUES. VALUE 
14 «OA 52 7D 00007 mova VALUE2, VALUE+8 
5 0B A4 9A 00008 MOVZBL YT tDESERIPD R2 
05 13 OO00F BEQL 4 
02 52 91 00011 CMPB OS soaR2, #2 
B 18 00014 BLEQU 
7E 006 8F 9A 00016 1$: MOVZBL #BASSK_ONEOR TWO, -(SP) 
000000006 00 1 FB OOOIA CALLS #1, BASS$$ST 
1C 02 A& 91 00021 28: CMPB (DESCRIP), #28 
13 88 ; BEQL $ 
7E 006 8F 9A MOVZBL #BAS ASSK chRGDONMAT. -(SP) 
000000006 00 1 FB 00 CALLS 1. BASS 
05 OA Ab 3 99 3$: BBC OcDESCRIPY 4$ 
OA Aa 95 TSTB Ae DESCR 
19 9 A BLSS 
43 006 9A 48: MOVZBL #BASSK ARGDONMAT, -(SP) 
000000006 0 FB 0004 CALLS 
04 At 14 9E 904 58: MOVAB goine py reR 
14 A442 DE 0004C MOVAL ine) MUL IP BOUNDS 


a 


BA IRTUAL_ARR 
toss 
08 OA es ; 
3 
6€ 1 
9 
3 ? 
E 01 
52 3 F 
08 AE 5 $) 
39 
08 AE 
01 : 
08 
58 55 
9? 
58 6 
50 52 01 
FB A340 58 
92 
FC A340 8 
08 
7E 00G 8F 
000000006 00 01 
50 04 ag 04 
51 5 60%4 
57 51 5 
BD 
51 64 
51 57 
57 51 10 A4 
BF OA8F 03 AG 
10 
Oc AE 
0090 =F 
00000000G 00 Fs 
04 03 A4 
08 
7E 00G 8F 
000000006 00 01 
50 oc ag 
51 5 
000000006 00 
5€ 1¢ 
; Routine Size: 252 bytes, Routine Base: _BASSCODE 
3 3477 8 1 
3 8 629 1 END 
3; 3479 630 1 
3 631 0 ELUDOM 


ee 


On 9 ONO 0 "DO" QDNNW "NNO O90 SO IO SO HO SO NNONVOITO-nNvVJIom 
— NOCOMD Pw DD BN SFO WT BP 1 " 0" DO ON) WO FWOOO— MOo— 


~~ 


7 
1b-sop-19 4 9: 
14-Sep-1984 11: 
1 BBC 
g MOVL 
MOVL 
3 C MNEGL 
SF BRA 
61 6$: MOVL 
64 MOVL 
067 MOVL 
006A 7$: SUBL3 
B06 CLRL 
00 ADDL 
it 8$: ADDL 
007 CMPL 
007C BEQL 
0007E CMPL 
Bppes BNEQ 
0083 MOVL 
914 BRB 
4 9$: MOVL 
0088 10$: ASHL 
0008F CMPL 
0094 BLSS 
0096 CMPL 
0098 BLEQ 
00090 11% MOVZBL 
Bopay CALL 
OOA8 12% SUBL 
OQO0AD MULL 
00082 ADDL 
00086 BoB 
00088 13% MOVZWL 
pores preg 
008 ADDL 
pepe CMPB 
00C BNEQ 
OQOOCA PUSHAB 
000CD PUSHR 
ie CALLS 
0008 BRB 
OODA 14% CMPB 
493 BEQL 
OOE MOVZBL 
OOE4 CALLS 
OOEB 15$: MOV 
OOEF MOVL 
et JSB 
OOOF8 168: ADDL2 
000FB $B 
6F 
! end of 


NDEX_NUMBER, #1 
INDEX1, INDEX_VALUE 

IND INDEX_VALUE 

EX purer RO 
INDEX_VALOE , -8 (BOUNDS) [ROJ 
INDEX_VALUE , -4 (BOUNDS) [RO] 
#BASSK_SUBOUTRAN, -(SP) 
TOP 


#4. MULTIPLIERS 
(RO) CINDEX_NUMB 


INDEX2 
#1, IND 


#1, BASS$S 


3(DESCRIP), 
14$ 


VALUE 
#*M<R 


4,R7> 
#3, BASSSVA_STORE 
3(DESCRIP), #4 
15$ 


S$K_NOTIMP, -(SP) 
#1, BASSSSTOP 
VALUE, RO 
VALUE LOCATION, R1 
BASSSCOPY_H_RS 
#28, SP 


#BA 


module BASS$VIRTUAL_ARR 


RO 
ER], VALUE_LOCATION, R1 
NOEX_VALUE, R1, VALUE_LOTATION 


(DESCRIP), R1 
ATION 


R1 
YO(DESCRIP), Ri, VALUE_LOCATION 


9:44 cores Bliss-32 v4.0-74 Page 
6:46 BASRTL.SRCJBASVIRTUA.B32;1 
#5, 1O(DESCRIP), 6$ 
R2, LOW INDEX 
#1, HIGR_INDEX 
4g INDER_INCR 
#1, LOW] 
Re. HIGA_IN 
#1, INDER_INCR 
INDEX_INCR, LOW INDEX, INDEX_NUMBER 
VALUE ~LOCATION 
INDEX-INCR, HIGH_INDEX, 8(SP) 
INDEX~INCR 
INDEX NUMBER, 8(SP) 


1 


~ 


WAMMAMMMMMIA 
RLSArusoanws CF 


3596 


_ 
| d 7 
| BASSVIRTUAL_ARR 16-Sep-1984 01:29:44 AX-11 Bliss-32 v4.0-7 Page 105 
bee a atts 1 1886 BASRTL.SRCJBASVIRTUA. 8 2;1 9° 20) 
| 
| 
; PSECT SUMMARY 
; Name Bytes Attributes 
: _BASSCODE 6251 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN‘2) 
; Library Statistics 
; cocesees Syabols oooee--- Pages Processing 
: File Total Loaded Percent Mapped Time 
: _$255S$DUA28:(SYSLIBISTARLET.L32;1 9776 26 0 581 00:01.0 
; COMMAND QUALIFIERS 
; BLISS/CHECK= (FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=L1S$:BASVIRTUA/OBJ=0BJ$:BASVIRTUA MSRC$:BASVIRTUA/UPDATE=(ENHS :BASVIRTUA 
Size: 6251 4, cege + 0 data bytes 
Run Time 
Elapsed Time: 05: 55. 
Lines/CPU Min 1915 


Lexenes/CPU-Rin: 17555 
"Y Used: 245 pages 
os ation Complete 
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